GET "FED.DEFS"


LET TRANSLATECHAR(XX, YY) BE
[
    LET TMP,NWA,NBA,OWA,OBA = NIL,NIL,NIL,NIL,NIL
    [ TMP = (RV 177030B)&7] REPEATUNTIL TMP EQ 7
    [ RV 426B = -1 
      TMP = (RV 177030B)&7 
      RV 426B = RV 424B
      RV 427B = RV 425B] REPEATUNTIL TMP EQ 5
    LET NX = (RV 424B) - CLMARGIN + 2
    LET NY = (RV 425B) - CTOPMARGIN + 2
    NX = NX LS 0? 0, NX/BOXSIZE
    NY = NY LS 0? 0, NY/BOXSIZE
    NX = NX LS (FWMAX*16)? NX, (FWMAX*16) - 1
    NY = NY LS FHMAX? NY, FHMAX - 1

    LET DX = NX - XX
    LET DY = NY - YY
    LET NFARRAY = VEC FWMAX*FHMAX
    BSTORE(NFARRAY, 0, FWMAX*FHMAX-1)

    TMP = DX; IF DX LS 0 THEN TMP = -DX
    TEST DX EQ 0 IFNOT[
        FOR I=0 TO FHMAX-1 DO[
            TEST DX GR 0 IFSO [
                NWA = NFARRAY+(I+1)*FWMAX - 1
                NBA = 15
                OWA = FARRAY +(I+1)*FWMAX - 1 - DX/16
                OBA = NBA - DX REM 16]
                IFNOT[
                NWA = NFARRAY + I*FWMAX
                NBA = 0
                OWA = FARRAY + I*FWMAX - DX/16
                OBA = NBA + TMP REM 16]
            FOR J=0 TO FWMAX*16 - TMP -1 DO [
                IF RV OWA NE 0 THEN
                    RV NWA = RV NWA%(100000B RSHIFT OBA & RV OWA) RSHIFT (NBA - OBA)
                TEST DX GR 0 IFSO[
                    NBA = NBA - 1
                    IF NBA LS 0 THEN [ NBA = 15; NWA = NWA -1]
                    OBA = OBA - 1
                    IF OBA LS 0 THEN [ OBA = 15; OWA = OWA - 1]]
                    IFNOT[
                    NBA = NBA + 1
                    IF NBA GR 15 THEN [ NBA = 0; NWA = NWA + 1]
                    OBA = OBA + 1
                    IF OBA GR 15 THEN [ OBA = 0; OWA = OWA + 1]]]]]
        IFSO BMOVE(FARRAY, NFARRAY, FHMAX*FWMAX - 1)
    BSTORE(FARRAY, 0, FHMAX*FWMAX - 1)

    TEST DY GE 0 IFSO [
        FOR I = FHMAX-1 TO DY BY -1 DO
            BMOVE(NFARRAY+(I-DY)*FWMAX,FARRAY+(I)*FWMAX,FWMAX-1)]
        IFNOT[
        FOR I=0 TO FHMAX-1+DY DO
            BMOVE(NFARRAY+(I-DY)*FWMAX,FARRAY+(I)*FWMAX,FWMAX-1)]

    BUILDCHAR()
    SETTICK(FCWIDTH,TRUE)
    ]

AND SETCHARWIDTH() BE
[
  LET TMP = NIL
  WS("*NBUG RIGHTMOST DESIRED BIT")
  [ TMP = (RV 177030B)&7] REPEATUNTIL TMP EQ 7
  [ TMP = (RV 177030B)&7
    RV 426B = RV 424B
    RV 427B = RV 425B] REPEATUNTIL TMP EQ 3
  WS("*N!")
  LET NX = (RV 424B) - CLMARGIN + 2
  NX = NX LS 0? 0, NX/BOXSIZE
  NX = NX LS (FWMAX*16)? NX, (FWMAX*16) - 1
  FCWIDTH = NX+1
  BUILDCHAR()
  SETTICK(FCWIDTH,TRUE)
]