§ Код программы
SCREEN 13 DrawGrid DrawText cx% = 0: cy% = 0 dx% = 0: dy% = 0 LOCATE 2, 19: PRINT "S-Save font.bin" LOCATE 3, 19: PRINT "L-Load font.bin" mode = 1 DO UpdateGrid cx%, cy%, 1 IF mode = 0 THEN SetGrid dx%, dy%, 15 DO: i$ = INKEY$: LOOP WHILE i$ = "" lf = 0: rt = 0: up = 0: dn = 0 IF i$ = CHR$(0) + "K" THEN lf = 1 IF i$ = CHR$(0) + "M" THEN rt = 1 IF i$ = CHR$(0) + "H" THEN up = 1 IF i$ = CHR$(0) + "P" THEN dn = 1 IF i$ = "s" OR i$ = "S" THEN SaveFont ' MODE = 0: Draw 8x8 Block IF mode = 0 THEN SetGrid dx%, dy%, 8 IF lf AND dx% > 0 THEN dx% = dx% - 1 IF rt AND dx% < 7 THEN dx% = dx% + 1 IF up AND dy% > 0 THEN dy% = dy% - 1 IF dn AND dy% < 7 THEN dy% = dy% + 1 IF i$ = CHR$(27) THEN mode = 1: i$ = "" ' Swap color IF i$ = " " THEN ax = 8 + 8 * cx% + dx% ay = 80 + 8 * cy% + dy% n = POINT(ax, ay) k = n <> 8 AND n <> 0 IF k THEN c = 8 ELSE c = 15 PSET (ax, ay), c END IF ELSE UpdateGrid cx%, cy%, 0 IF lf AND cx% > 0 THEN cx% = cx% - 1 IF rt AND cx% < 31 THEN cx% = cx% + 1 IF up AND cy% > 0 THEN cy% = cy% - 1 IF dn AND cy% < 7 THEN cy% = cy% + 1 IF i$ = CHR$(13) THEN mode = 0: i$ = "" END IF LOOP UNTIL i$ = CHR$(27) AND mode = 1 SUB DrawGrid ox = 8 oy = 8 FOR y = 0 TO 7 FOR x = 0 TO 7 LINE (ox + 8 * x, oy + 8 * y)-(ox + 8 * x + 8, oy + 8 * y + 8), 8, B NEXT NEXT END SUB SUB DrawText COLOR 7 FOR y = 1 TO 7 FOR x = 0 TO 31 LOCATE 10 + y, x + 2: PRINT CHR$(x + 32 * y); NEXT NEXT END SUB SUB SaveFont OPEN "font.bin" FOR OUTPUT AS #1 FOR i = 0 TO 255: PRINT #1, CHR$(0); : NEXT FOR y = 0 TO 6 FOR x = 0 TO 31 FOR i = 0 TO 7 t = 0 FOR j = 0 TO 7 n = POINT(8 + x * 8 + j, 80 + y * 8 + i) k = n <> 8 AND n <> 0 t = t * 2 IF k THEN t = t + 1 NEXT PRINT #1, CHR$(t); NEXT NEXT NEXT CLOSE #1 END SUB SUB SetGrid (x%, y%, c) LINE (8 + x% * 8, 8 + y% * 8)-(8 + x% * 8 + 8, 8 + y% * 8 + 8), c, B END SUB SUB UpdateGrid (x%, y%, t%) ox = 8 oy = 80 FOR i = 0 TO 7 FOR j = 0 TO 7 ax = ox + j + x% * 8 ay = oy + i + y% * 8 a = POINT(ax, ay) k = (a <> 8) AND (a <> 0) IF k THEN c = 7 ELSE c = 0 IF t% > 0 THEN IF k THEN B = 15 ELSE B = 8 ELSE IF k THEN B = 7 ELSE B = 0 END IF PSET (ax, ay), B LINE (8 + 8 * j + 1, 8 + 8 * i + 1)-(8 + 8 * j + 7, 8 + 8 * i + 7), c, BF NEXT NEXT END SUB
23 сен, 2021
© 2007-2023 Родился, женился, получил права