( FontEd )
( A Jupiter Ace font editor)
( by Ricardo Fernandes Lopes - Feb-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 ." Toogle"
 CR ." Clear"
 CR ." Next"
 CR ." Previous"
 CR ." ASCII sel."
 CR
 CR ." Quit"
 CR
 CR ." ___Ricardo_F._Lopes______2007___"
 ;

: .SCREEN
 CLS ." __FontEd__" CR
 8 0
 DO
  ." _        _" CR
 LOOP
 ." ___v1.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 varianle 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 ;

( Font Editor main routine)
: FED
 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 T = IF TOOGLE UPDATE .LINE THEN ( Toogle bit          )
  DUP ASCII C = 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
 ;

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