( FontEd v2.0 )
( A Jupiter Ace font editor)
( by Ricardo Fernandes Lopes - June-2007 )

( Loading a font file: FONT BLOAD <fontfile> )
( Starting the Editor: FED )
( Saving a font file:  FONT BSAVE <fontfile> )
( Using a font file:   11264 1024 BLOAD <fontfile> )

( Font subset saving & loading using FROM and TO)
( To save only a font subset use: )
(   65 FROM 90 TO BSAVE mycapitals )
( To load it back use: )
(   65 FROM 90 TO BLOAD mycapitals )

32 CONSTANT BL  ( The blank character)

16 BASE C!    ( Hex )

CREATE CMOVE ( src dst count -- , move 'count' bytes from 'src' to 'dst')
 DF C,         ( RST 18    ; get 'count'           )
 42 C,         ( LD B,D    ; BC = 'count'          )
 4B C,         ( LD C,E                            )
 DF C,         ( RST 18    ; get 'dst'             )
 D5 C,         ( PUSH DE   ; save it               )
 DF C,         ( RST 18    ; get 'src'             )
 E1 C,         ( POP HL    ; recover 'dst'         )
 EB C,         ( EX DE,HL  ; DE = 'dst' , HL='src' )
 ED C, B0 C,   ( LDIR      ; move bytes            )
 FD C, E9 C,   ( JP (IY)   ; end                   )
CMOVE DUP 2- ! ( Make CMOVE an executable word )

DECIMAL     ( back to Decimal )

: KEY ( -- c ,wait for keypress converting to uppercase)
 BEGIN INKEY ?DUP UNTIL  ( Wait for a keypress)
 223 AND                 ( Quick & Dirty uppercase converter)
 BEGIN INKEY 0= UNTIL    ( Wait for key release)
 ;

CREATE FONTS 1024 ALLOT  ( 128 Font patterns)
 0 VARIABLE X            ( Cursor X position)
 0 VARIABLE Y            ( Cursor Y position)
64 VARIABLE F            ( Current selected font )

: FONT>  ( c -- adr )  127 AND 8 * FONTS + ;  ( Get a font address)
: CHAR>  ( c -- adr )  127 AND 8 * 11264 + ;  ( Get a char generator address)
: FONT   ( -- adr u )  FONTS 1024 ;           ( Prepare stack to bsave/bload a font)
: UPDATE  F C@ DUP FONT> SWAP CHAR> 8 CMOVE ; ( Copy current font to char generator)

( Bit mask table: 0 -> 00000001 ... 7 -> 10000000 )
CREATE MASKS 128 C, 64 C, 32 C, 16 C, 8 C, 4 C, 2 C, 1 C,
: MASK> ( bitaddress -- bitmask )  MASKS + C@ ;

: TOOGLE  ( toogle the X,Y bit of current font )
 F C@ FONT>  ( Current font address )
 Y C@ +      ( selected font line -> byte address  )
 X C@ MASK>  ( selected font column -> Bit mask )
 OVER C@ XOR ( Toogle selected font bit )
 SWAP C!     ( Store it back )
 ;

( Show the bit pattern of a byte )
: .BITS ( c -- )
 8 0                 ( 8 bits)
 DO
  I MASK> OVER AND   ( check bits one by one)
  IF
   ASCII #           ( bit=1 -> #)
  ELSE
   BL                ( bit=0 -> blank)
  THEN
  EMIT
 LOOP
 DROP
 ;

: .LINE  ( Print the bit pattern of the current font line )
 F C@ FONT>   ( Current font address)
 Y C@         ( Current cursor line)
 DUP 1+ 1 AT  ( at the correct screen position..
 + C@ .BITS   ( ..Show bit pattern )
 ;

: .ZOOM ( Show the bit pattern of the current font )
 F C@ 9 11 AT DUP . ( Show the selected ASCII code )
 DUP 9227 C!        ( Show the selected char )
 FONT>              ( font address)
 9 1                ( 8 font lines)
 DO
  DUP C@            ( Get font )
  I 1 AT .BITS      ( print bit pattern line by line)
  1+
 LOOP
 DROP
 ;

: .MAP ( show all characters on the screen )
 9232        ( screen position where we want to start show)
 16 0        ( 16 lines..)
 DO
  16 0       ( ..and 16 columns)
  DO
   I J 16 * + OVER C!  ( Put chars on the screen memory)
   1+
  LOOP
  16 +
 LOOP
 DROP
 ;

: .MENU
 CR ."  I"
 CR ." JKL Cursor"
 CR
 CR ." T Toogle"
 CR ." Z Invert"
 CR ." C Copy"
 CR ." V Paste    P Previous"
 CR ." X Clear    N Next"
 CR
 CR ." Q Quit       A ASCII select"
 CR
 CR ." ___Ricardo_F._Lopes______2007___"
 ;

: .SCREEN
 CLS ." __FontEd__" CR
 8 0
 DO
  ." _        _" CR
 LOOP
 ." ___v2.0___" CR
 .MENU .ZOOM .MAP
 ;

: CURSOR> ( -- adr , Get cursor screen address)
 Y C@ 1+ 32 *
 X C@ + 9217 +
 ;

( Show/hide cursor)
: CURSOR-ON   CURSOR> C@ 128 OR  CURSOR> C! ;
: CURSOR-OFF  CURSOR> C@ 127 AND CURSOR> C! ;

: CLEAR ( Erase current font pattern)
 F C@ FONT>  ( Font address)
 8 0         ( Erase 8 bytes)
 DO
  0 OVER C! 1+
 LOOP
 DROP
 ;

( Increment and decrement a byte variable limiting to 0-7 )
: INC ( adr -- ) DUP C@ 1+ 7 MIN SWAP C! ;
: DEC ( adr -- ) DUP C@ 1- 0 MAX SWAP C! ;

( Cursor Movement )
: UP     Y DEC ;
: DOWN   Y INC ;
: LEFT   X DEC ;
: RIGHT  X INC ;

( Font Selection )
: PREV   F DEC ;
: NEXT   F C@ 1+ 127 MIN F C! ;

: INPUT ( -- n , Query user input)
 QUERY NUMBER ( 0 , INTEGER 4102 , FLOAT 4181)
 DUP 0>  ( is it a number?)
 IF
  4181 = ( is it a float number?)
  IF
   INT
  THEN
 THEN
 0 MAX 127 MIN ( limit range)
 ;

( Copy all fonts to the char generator)
: INSTALL  FONTS 11264 1024 CMOVE ;

CREATE CLIPBRD 8 ALLOT   ( Clipboard used by Copy&Paste )

: COPY  ( Copy current font to the clipboard )
 F C@ FONT> ( Source = Current font address )
 CLIPBRD    ( Destination = Clipboard )
 8 CMOVE    ( copy 8 bytes )
 ;

: PASTE  ( Paste font from clipboard )
 CLIPBRD    ( Source = Clipboard )
 F C@ FONT> ( Destination = Current Font Address )
 8 CMOVE    ( copy 8 bytes )
 ;

: INV  ( Invert all pixels of the current char font )
 F C@ FONT> ( Get font address )
 8 0        ( 8 bytes )
 DO
  DUP C@  ( Get font byte )
  255 XOR ( Invert bits )
  OVER C! ( Store it back )
  1+      ( Next byte )
 LOOP
 DROP     ( Discard font address )
 ;

( Words to help save/load a font subset )
: FROM  ( c -- c adr )             DUP 8 * FONTS + ;
: TO    ( c1 adr c2 -- adr size )  ROT - 1+ 8 * ;

: FED  ( Font Editor main routine)
 INVIS .SCREEN INSTALL     ( Initialize )
 BEGIN
  CURSOR-ON KEY CURSOR-OFF ( Get pressed key)
  DUP ASCII Q = 0=         ( Not Quit?)
 WHILE
  DUP ASCII I = IF UP    THEN               ( Move Cursor Up      )
  DUP ASCII J = IF LEFT  THEN               ( Move Cursor Left    )
  DUP ASCII K = IF DOWN  THEN               ( Move Cursor Down    )
  DUP ASCII L = IF RIGHT THEN               ( Move Cursor Right   )
  DUP ASCII C = IF COPY  THEN               ( Copy to clipboard   )
  DUP ASCII V = IF PASTE  UPDATE .ZOOM THEN ( Paste from clipboard)
  DUP ASCII T = IF TOOGLE UPDATE .LINE THEN ( Toogle bit          )
  DUP ASCII Z = IF INV    UPDATE .ZOOM THEN ( Invert all bits     )
  DUP ASCII X = IF CLEAR  UPDATE .ZOOM THEN ( Clear pattern       )
  DUP ASCII N = IF NEXT   .ZOOM THEN        ( Next char           )
  DUP ASCII P = IF PREV   .ZOOM THEN        ( Previous char       )
  ASCII A = IF INPUT F C! .ZOOM THEN        ( Choose by ASCII code)
 REPEAT
 DROP
 ;