Phonex we wątku o Startach na ZX użył procedury do przerabiania oryginalnego fonta na ukośny.
I przypomniało mi się że zrobiłem coś takiego w Basicu parę miesięcy temu, a nigdzie tego nie wstawiałem.
Obrazek pokazuje wszystkie przekształcenia jakie ten programik potrafi na przykładzie fonta CPC. Ale równie dobrze można by go użyć w innym komputerze, lub na innym foncie. Dlatego wstawiam jako tekst anie plik wykonywalny. Przecież każdy potrafi zapisać tekst skopiowany ze strony jako plik tekstowy i wczytać go do emulatora prawda?
W listingu na końcu każdej linii jest komentarz co ta linijka robi. Może nie wszystkie znaki wyglądają dobrze po takich przeróbkach, ale zawsze to oszczędność czasu w porównaniu do pikselowania wszystkiego od zera. Można modyfikować ten sam font kilkakrotnie na różne sposoby. Np. fajnie wygląda zwęzić font, potem przechylić i dodać te kreseczki na bokach które nadają złudzenie pisma odręcznego.
Obrazek pokazuje fonty po następujących modyfikacjach:
normalny
pogrubiony
wychudzony
przechylony
pismo ręczne (standardowy font słabo z tym wygląda)
podkreślony
obniżony
podwyższony
zwężony o 1 piksel
poszerzony o 1 piksel
zwężony o połowę
poszerzenie wąskiego ze zachowaniem kanciastości
A oto co robią poszczególne podprogramy w liniach o numerach:
40 normal,
50 wyświetl fonta
60 Bold, pogrubiony
70 skiny, wychudzony
80 script, dodaje kreski jak przy piśmie odręcznym
90 underline, podkreślenie
100 Italic, ukośne
110 smaller, obniżenie fonta o linijkę (w Spectrum i małym Atari są takie)
130 bigger, podwyższenie o linijkę
150 narrow, zwężenie o jeden piksel (np w Apple i w MSX są takie węższe)
160 wider, poszerzenie o jeden piksel
170 half, zwężenie o połowę z 8 na 4 piksele
180 double, poszerzenie z 4 pikseli na 8
10 MODE 2:GOSUB 40:DEFINT a-z:m=VAL("&"+HEX$(HIMEM))+1:GOSUB 50' ZbyniuR 2018
20 GOSUB 60:GOSUB 50:GOSUB 40:GOSUB 70:GOSUB 50:GOSUB 100:GOSUB 50:GOSUB 40:GOSUB 80:GOSUB 50:GOSUB 40:GOSUB 90:GOSUB 50:GOSUB 40:GOSUB 110:GOSUB 50:GOSUB 130:GOSUB 50:GOSUB 40:GOSUB 40:GOSUB 150:GOSUB 50:GOSUB 160:GOSUB 50:GOSUB 40:
30 GOSUB 170:GOSUB 50:GOSUB 180:GOSUB 50:GOSUB 40:CALL &BB18:END
40 SYMBOL AFTER 32:INK 0,0:INK 1,26:RETURN' back to normal font
50 FOR a=32 TO 126:PRINT CHR$(a);:NEXT:PRINT:g=m+8:q=m+95*8:RETURN' show all
60 FOR a=g TO q:p=PEEK(a):POKE a,(p OR p/2):NEXT:RETURN' Bold
70 FOR a=g TO q:p=PEEK(a):POKE a,(p AND p/2):NEXT:POKE m+511,255:RETURN' skiny
80 g=g+261:FOR a=g TO q STEP 8:POKE a,PEEK(a)OR 195:NEXT:RETURN' script
90 g=g-1:FOR a=g TO q STEP 8:POKE a,255-PEEK(a):NEXT:RETURN' underline
100 FOR a=g TO q STEP 8:FOR e=0 TO 1:POKE a+e,PEEK(a+e)/2:NEXT:FOR e=5 TO 7:POKE a+e,PEEK(a+e)*2 MOD 256:NEXT:NEXT:RETURN' Italic
110 FOR a=g TO q STEP 8:IF a<-24492 OR a>-24124 THEN w=3 ELSE w=2
120 FOR e=w TO 1 STEP-1:POKE a+e,PEEK(a+e-1):NEXT:POKE a,0:NEXT:RETURN' smaller
130 FOR a=g TO q STEP 8:IF a<-24492 OR a>-24124 THEN w=3 ELSE w=1
140 FOR e=0 TO w:POKE a+e,PEEK(a+e+1):NEXT:NEXT:RETURN' bigger
150 FOR a=g TO q:p=PEEK(a):POKE a,(p AND 240)OR(p AND 7)*2:NEXT:RETURN' narrow
160 FOR a=g TO q:p=PEEK(a):POKE a,(p AND 240)OR(p AND 30)/2:NEXT:RETURN' wider
170 FOR a=g TO q:p=PEEK(a):POKE a,(p AND 64)+(p AND 16)*2+(p AND 4)*4:NEXT:RETURN' half
180 FOR a=g TO q:p=PEEK(a):POKE a,(p AND 64)*1.5+(p AND 32)*0.75+(p AND 16)*0.375:NEXT:RETURN' double
Przydałoby się dodać opcje do wczytywania i zapisywania fonta, ale jakoś tego nie dokończyłem.
