 
*  EE3/DATEN    40 col        Jul / 18 / 93
*----------------------
*  All Chars / All Mode
 
*----------------------------
*  Details of language screen
*----------------------------
 
WPC12  EQU  6*SW+5
WPC23  EQU  13*SW+5
WPC38  EQU  3*SW+5
 
WPEDSC EQU  $
       MOV  R11,R10
       CLR  @ESFLAG           Shut off for FILENT
       BL   @FWCLS            Clear TM1 screen
       BLWP *R9
       DATA 2*SW+5
       DATA SLMS10,SLML10
       MOVB @UDLINE,R0        ED underline
       BLWP *R8
       DATA 3*SW+5,SLML10
       BLWP *R9
       DATA WPC12
       DATA SLMS20,SLML20
       BLWP *R9
       DATA 2*SW+4+WPC12
       DATA SLMS21,SLML21
 
*  Select W/P or P/E
 
       SETO R4                Initialize with flag for Pr/Ed
WPEDC1 BLWP @FILENT           Wait for response
       DATA WPC12,1
       MOVB @FLNBFF,R0        Fetch return
       CB   R0,@INTGRS+1      Is it < "1" ?
       JLT  WPEDC1            No
       CB   R0,@INTGRS+2      Is it "2" or "1"
       JH   WPEDC1            No - loop on it
       JEQ  NTL78C            P/E so leave as is
       CLR  R4                Flag W/P then
 
*  Choices for 7 or 8 bit
 
NTL78C EQU  $
       SB   @LNGTYP,@LNGTYP   Initialize in case no entry
       BLWP *R9
       DATA WPC23
       DATA SLMS22,SLML22
       MOVB @UDLINE,R0        ED underline
       BLWP *R8
       DATA 1*SW+WPC23,SLML22
       BLWP *R9
       DATA 3*SW+WPC23
       DATA SLMS23,SLML23
       BLWP *R9
       DATA 5*SW+WPC23+4
       DATA SLMS24,SLML24
       BLWP *R9
       DATA 7*SW+WPC23+4
       DATA SLMS25,SLML25
       BLWP *R9
       DATA 9*SW+WPC23+4
       DATA SLMS26,SLML26
CH78C1 BLWP @FILENT           Wait for response
       DATA 3*SW+WPC23,1
       MOVB @FLNBFF,R1        Fetch return
       SB   @INTGRS+1,R1      Is it "1" ?
       JLT  CH78C1
       CB   R1,@BYT4
       JHE  CH78C1
 
       BL   @FWCLS            Clear screen
       MOVB R1,@LDTYPB        Set up LoaDTYPeByte
       JEQ  NATLEX
       SB   @WRITE,R1
       JEQ  CH78C2
 
*  Set national language choice
 
       BLWP *R9               Header
       DATA WPC38
       DATA SLMS30,SLML40
       JMP  CH78C3
CH78C2 BLWP *R9               Header
       DATA WPC38
       DATA SLMS40,SLML40
CH78C3 MOVB @UDLINE,R0       Underline
       BLWP *R8
       DATA 1*SW+WPC38,SLML40
       BLWP *R9
       DATA 4*SW+WPC38
       DATA SLMS41,SLML41     Australia
       BLWP *R9
       DATA 6*SW+5+WPC38
       DATA SLMS42,SLML42     Britain
       BLWP *R9
       DATA 8*SW+5+WPC38
       DATA SLMS43,SLML43     France
       BLWP *R9
       DATA 10*SW+5+WPC38
       DATA SLMS44,SLML44     Germany
       BLWP *R9
       DATA 12*SW+5+WPC38
       DATA SLMS45,SLML45     Italy
       BLWP *R9
       DATA 14*SW+5+WPC38
       DATA SLMS46,SLML46     Sweden
       BLWP *R9
       DATA 16*SW+5+WPC38
       DATA SLMS47,SLML47     Holland
       BLWP *R9
       DATA 18*SW+5+WPC38
       DATA SLMS48,SLML48     Spain
 
*  Select 1 to 8 in RH box
 
       LI   R0,WPEDCH         Back to first screen
       MOV  R0,@ESFLAG        Load <esc> pointer
SEL128 BLWP @FILENT           Wait for selection
       DATA 4*SW+WPC38,1
       MOVB @FLNBFF,R0        Fetch return
       SB   @INTGRS+1,R0      Check range
       JLT  SEL128            Out
       CB   R0,@EIGHT         Upper end
       JH   SEL128            Out
 
       MOVB R0,@LNGTYP       Save as language type
NATLEX CLR  @ESFLAG
       BL   @FWCLS           Clear before exit
       B    *R10
 
*---------------------------------------------
*  Fix up PABdata for char and text file loads
*---------------------------------------------
 
FIXPBS EQU  $
       LI   R10,NAMBUF        FW name buffer
       LI   R1,PABCHN         PAB data at length byte
       LI   R2,PABFWN         For textfile name also
       LI   R3,PABHLN
       MOVB *R10,R0           Fetch it - includes 2 letter filename
       SRL  R0,8              Make index
       DEC  R0                Includes len byte and "."
       AB   @BYT4,*R10        Adjust for 6 char filename
CFT10  MOVB *R10,*R1+
       MOVB *R10,*R2+         Transfer pathname
       MOVB *R10+,*R3+
       DEC  R0
       JGT  CFT10
 
       LI   R0,6               Move filenames into place
       LI   R5,CHRFLD
       LI   R12,FWTFLD
       LI   R14,HLPFLD
CFT20  MOVB *R5+,*R1+
       MOVB *R12+,*R2+
       MOVB *R14+,*R3+
       DEC  R0
       JGT  CFT20
       DECT R1                Back off pointer
       DECT R2
       DEC  R3
       MOV  R3,@INXADR
       RT
 
*  Load routine for char and text files
*--------------------------------------
 
LOADCT EQU  $
       LI   R0,VDPPAB+9
       MOV  R0,@SCNAME
       BLWP @TWDSLK
       DATA 8
       JEQ  BADLD
       BLWP @VSBRF
       DATA VDPPAB+1
       SRL  R0,13
       JNE  BADLD
       INCT R11
BADLD  RT
 
*  Clear char-file load fail message
 
CLRCHF EQU  $
       LI   R0,CFAILM
CLRCHG MOVB @DSPACE,*R0+
       CI   R0,CFAILE
       JL   CLRCHG
CLRCHH BLWP *R9
       DATA >8F8,ULNDTA,8
       RT
 
*  FW Clear TM1 Screen at >0  (from FW Wsp)
 
FWCLS  EQU  $
       LI   R0,>2000
       BLWP *R8
       DATA 0,>3C0
       RT
 
*  Selection screen messages
*---------------------------
 
 
SLMS10 TEXT 'SELECT TEXT EDITOR MODE'
SLML10 EQU  $-SLMS10
SLMS20 TEXT '1   1  Word Processing'
SLML20 EQU  $-SLMS20
SLMS21 TEXT '2  Program Editor '
SLML21 EQU  $-SLMS21
 
 
SLMS22 TEXT 'SELECT LANGUAGE MODE'
SLML22 EQU  $-SLMS22
SLMS23 TEXT '1   1  Default 7-bit'
SLML23 EQU  $-SLMS23
SLMS24 TEXT '2  National 7-bit'
SLML24 EQU  $-SLMS24
SLMS25 TEXT '3  All Characters'
SLML25 EQU  $-SLMS25
SLMS26 TEXT '4  TI Euro-Writer'
SLML26 EQU  $-SLMS26
 
SLMS40 TEXT 'COMMANDS / '
SLMS30 TEXT 'CHARACTER SET'
SLML40 EQU  $-SLMS40
       TEXT ' SELECTION '
SLML30 EQU  $-SLMS30
 
SLMS41 TEXT '1    1  DEFAULT'
SLML41 EQU  $-SLMS41
SLMS42 TEXT '2  BRITAIN'
SLML42 EQU  $-SLMS42
SLMS43 TEXT '3  FRANCE'
SLML43 EQU  $-SLMS43
SLMS44 TEXT '4  DEUTSCHLAND'
SLML44 EQU  $-SLMS44
SLMS45 TEXT '5  ITALIA'
SLML45 EQU  $-SLMS45
SLMS46 TEXT '6  SVERIGE'
SLML46 EQU  $-SLMS46
SLMS47 TEXT '7  NEDERLAND'
SLML47 EQU  $-SLMS47
SLMS48 TEXT '8  ESPANA'
SLML48 EQU  $-SLMS48
 
CFAILM TEXT 'Character File NOT Loaded'
CFAILE EQU  $
CFALM1 EQU  CFAILM-1
       EVEN
 
*  Default TAB table data
*------------------------
*  22 w
 
*  Primary format table  - Word processor
 
FRMWP  DATA 6,85
       BYTE 11,16,21,31,41,51,61,71
       BYTE 85,85,85,85,85,85,85,85
       DATA 6
 
 
*  Alternate Tab table  - Program editor
 
FRMPE  DATA 6,85
       BYTE 6,13,18,36,85,85,85,85
       BYTE 85,85,85,85,85,85,85,85
       DATA 6
 
 
*  TAB line data
 
INTGRS TEXT ' 123456789'
 
*  Initial messages
 
MSG26  TEXT 'FUNNELWEB  5.00 HD  - W/P'
MSL26  EQU  $-MSG26
MS27A  EQU  $-3
MS27B  EQU  $-1
MS28A  BYTE 'P'
MS28B  BYTE 'E'
BYT3   BYTE >03
BYT4   BYTE >04
EIGHT  BYTE >08
       EVEN
 
ACSR   DATA >2020,>5088,>8850,>2020
ULNDTA DATA >0000,>0000,>FF00,>0000
 
*  EQUates and initial data for SD
*---------------------------------
*  General EQU SDV = >1000
 
NSNAM  EQU  0+SDV             Name at top of screen
NSNAM1 EQU  2+SDV             DSKx. 2 in from right
NSNAM2 EQU  28+SDV            DSKx. vol name at right
NSUDL1 EQU  SW+SDV            Full underline under name
NSDHD  EQU  2*SW+SDV+1        File column headers
NSDHDU EQU  3*SW+SDV+1        Headers underline
 
NSFID  EQU  4*SW+SDV          Start of file data display
NSUDL2 EQU  20*SW+SDV         Under dir block
NWFNAM EQU  21*SW+SDV         Workfile name line
NWFNAP EQU  NWFNAM+4          Name position
NTFNAM EQU  22*SW+SDV         Tempfile name line
NTFNAP EQU  NTFNAM+4          Name position
NSUDL3 EQU  23*SW+SDV
NSPERR EQU  NSUDL3+2          Error/Message line
 
NSDVD  EQU  NSDHD+30          Divider
NSDVA  EQU  NSDVD+1           Right column start
 
NSFLC  EQU  SW+NSDVA+2        Filecount
NSPG1  EQU  2*SW+NSDVA+5      Page x
NSPG2  EQU  3*SW+NSDVA+5        of x
NSSUSD EQU  7*SW+NSDVA+2      Sectors used
NSSFRE EQU  9*SW+NSDVA+2      Sectors free
NSFBYT EQU  12*SW+NSDVA+1     Bytes free
 
*  Line positions on DP header line
 
HLSCS  EQU  8+12
HLSCF  EQU  8+20
HLSFCN EQU  8+26
HLSCU  EQU  8+34
HLSCUN EQU  8+40
HLFLC  EQU  8+50
HLFLCN EQU  8+57
 
*  Side column data
 
RCOLTX EQU  $
       TEXT 'Files  '
RCOLT1 TEXT '       '
       TEXT 'Page   '
       TEXT '  of   '
       TEXT '       '
SECU1  TEXT 'Sectors'
SECU2  TEXT '  Used '
       TEXT '       '
SECU3  TEXT '  Free '
       TEXT '       '
       TEXT '       '
       TEXT ' Bytes '
       TEXT '       '
       BYTE >1F,>1F,>1F,>1F,>1F,>1F,>1F
       TEXT '<QA,EX>'
       TEXT '<UPDVw>'
       TEXT '<cP>Dir'
       TEXT '<c=>Ex '
       TEXT '< =T>Mk'
       TEXT '<1-9>D#'
       TEXT '<0>Path'
RCOLTE EQU  $
RCOLTL EQU  RCOLT1-RCOLTX
 
WFNM   BYTE 3
       TEXT 'WF:'
TFNM   BYTE 3
       TEXT 'TF:'
FLCAP  BYTE >1D
       TEXT ' Filename  Size  '
       TEXT 'Type   Rec P'
ULN2   BYTE >1D
       TEXT '---------- ---- ------- --- -'
       EVEN
 
*  Initialize SD screen - in FW workspace
 
ISDSCR EQU  $
       LI   R0,>201F
       BLWP *R8               Clear SD screen & SDP buffers
       DATA SDV,>3C0+>A0      SDV+LINBUV+SDHBUV contiguous
       SWPB R0                Solid underline to fore
       BLWP *R8
       DATA NSUDL1,SW
       BLWP *R8
       DATA NSUDL2,SW
       BLWP *R8
       DATA NSUDL3,SW
 
*  Set up buffer lines for DP
 
       LI   R0,'--'
       BLWP *R8               Write line for SD print
       DATA LINBUV+8,64
       BLWP *R9
       DATA SDHBUV+HLSCS      "Sectors"
       DATA SECU1,7
       BLWP *R9
       DATA SDHBUV+HLSCF      "Free"
       DATA SECU3+2,4
       BLWP *R9
       DATA SDHBUV+HLSCU      "Used"
       DATA SECU2+2,4
       BLWP *R9
       DATA SDHBUV+HLFLC      "Files"
       DATA RCOLTX,5
 
*  Write up right column
 
       LI   R0,NSDVD         Divider
ISD10  LI   R1,>1E00
       BLWP @VSBWF
       AI   R0,8
       BLWP @VSBWF
       AI   R0,SW-8
       CI   R0,NSUDL3
       JL   ISD10
       LI   R0,NSDVA          Entries
       LI   R1,RCOLTX
       LI   R2,RCOLTL
ISD20  BLWP @VMBWR
       AI   R0,SW
       A    R2,R1
       CI   R1,RCOLTE
       JL   ISD20
 
*  Write SD page info headers
 
       LI   R10,VSTRWF
       LI   R0,FLCAP
       BLWP *R10              @VSTRWF
       DATA NSDHD
       LI   R0,ULN2
       BLWP *R10              @VSTRWF
       DATA NSDHDU
       LI   R0,WFNM
       BLWP *R10              @VSTRWF
       DATA NWFNAM
       LI   R0,TFNM
       BLWP *R10              @VSTRWF
       DATA NTFNAM
       RT
 
*-----------------------------------------
*  Code segments and overlays set at entry
*-----------------------------------------
 
*  Speed screen mapping - move to PAD
 
PAD01  MOVB *R10+,*R14
       DEC  R9                R14 = VDPWD
       JGT  PAD01-38
       RT
       DATA >2020             Fast space data
 
FCLOOP MOVB *R8+,*R9+
       DEC  R12
       JGT  FCLOOP
       RT
FCLEN  EQU  $-PAD01
FCEND  EQU  $
 
*  USA buffer manager codes
*--------------------------
 
USASQU EQU  $
       LI   R12,>0180         Byte saver and bit mask
SQSH10 C    R8,R7             All the line buffer read ?
       JHE  SQSH40            Yes
 
       MOVB *R8+,R0           Fetch a byte from line to MSB of R0
       ANDI R0,>7FFF          Strip MSByte for safety
       STWP R10               Point to R0
       CB   *R10+,*R10        Compare MSB (new char) to LSB (last char)
       JEQ  SQSH20            Repeated char
 
       INC  R9                Next target byte
       MOVB R0,*R9            Write byte to squish buffer
       SWPB R0                Move byte over for comparison use
       CLR  R6                Reset repeated char flag
       JMP  SQSH10            Go get another character
 
SQSH20 ABS  R6                Already a repeated char ?
       JNE  SQSH30            Yes
 
       SETO R6                Flag repeat has started
       SOCB @BUFMWS+25,*R9+   Set MSBit to flag repeats
       MOVB R12,*R9           Initialize repeat counter at 1
SQSH30 AB   R12,*R9           Add to repeat count  (Min = 2)
       JMP  SQSH10
 
SQSH40 CB   @-1(R9),@BA0      Repeated spaces at end ?
       JNE  SQSH50            No
 
       DECT R9                Omit last 2 bytes
SQSH50 S    R3,R9             Chars written
       INC  R9                Include length byte itself
       MOV  R9,R6             Copy for the record
       SLA  R9,8              Byte adjust
       MOVB R9,*R3            Write to length byte
       RT                     RETURN
 
USASQL EQU  $-USASQU
 
*  USA default overlay code for Unsquish
*---------------------------------------
 
USAUNS EQU  $
 
*  Fresh character
 
GTTL10 C    R8,R12            Too far ?
       JHE  GTTL60            Yes
 
       MOVB *R8+,*R9+         Get character and write to target
       JLT  GTTL30            Repeat flagged
 
GTTL20 C    R9,R7             Don't overrun target buffer
       JHE  SUBXBR            Quit while ahead
       JMP  GTTL10            Get another byte
 
*  Repeat characters
 
GTTL30 DEC  R9                Back up to flagged byte
       MOVB *R9,R0            Fetch it
       ANDI R0,>7FFF          Strip MSbit
       MOVB *R8+,R10          Get repeat count from next byte
       SRL  R10,8             Word adjust
GTTL40 MOVB R0,*R9+           Repeat character in LINEBUF
       DEC  R10               Is this to be repeated ?
       JGT  GTTL40            Yes
       JMP  GTTL20            Finished with squished record
 
*  Fill rest of line if implicit blanks
 
GTTL60 C    R9,R7             Has it quit before buffer full ?
       JHE  SUBXBR            No - already filled
 
       MOVB @DSPACE,*R9+      Fill the rest with spaces
       JMP  GTTL60            Loop on the fill
 
SUBXBR B    @SUBXIT
 
USAUNL EQU  $-USAUNS
 
 
 
 
******************************
*  Write over REFRMT for Pr/Ed
 
ASMCOD EQU   $                71 w
       MOV   R11,R14          Save return
       ABS   @ASPARS          Check if in ASMODE
       JEQ   ASMCEX           No
 
       LI   R15,'* '          Load comparison bytes
       MOV  @BUFADR,R8        Point to current line buffer
       CB   *R8,R15           Comment line ?
       JEQ  ASMCEX            Yup - no further action
 
*  Not a comment line
 
       SWPB R15               Blank for byte comparisons
       MOV  R8,R9             Copy pointer
       AI   R9,LLL            Point to end of line
 
*  Do label field
 
LABEL  C    R8,R9             End of line ?
       JHE  ASMCEX            Yes
       CB   *R8,R15           Blank ?
       JEQ  GAP1              Yes - go scan for next field
 
       BL   @CNVLC8           UPCASE
       INC  R8                Next char
       JMP  LABEL             Go look at it
 
*  Cross gap to Opcode field
 
GAP1   C    R8,R9             End of line ?
       JHE  ASMCEX            Quit
       CB   *R8+,R15          Blank ?
       JEQ  GAP1              Yes
       DEC  R8                Back off to char
 
*  Check Opcode field for illegal chars
 
OPCODF C    R8,R9             End of line ?
       JHE  ASMCEX            Yes
       CB   *R8,R15           Blank ?
       JEQ  GAP2              Yes
 
       BL   @CNVLC8           UPCASE
       CB   *R8,@UCA          Lower ASCII limit "A" ?
       JL   ASMERR            Bad char
       CB   *R8+,@UCZ         Upper ASCII limit "Z" ?
       JH   ASMERR            Bad char
       JMP  OPCODF            Check next
 
*  Search for Operand field
 
GAP2   C    R8,R9             End of line ?
       JHE  ASMCEX            Quit
       CB   *R8+,R15          Blank ?
       JEQ  GAP2              Yes
       DEC  R8                Back off to char
 
*  Convert Operand field
 
       CLR  R10               Quote counter
OPRND  C    R8,R9             End of line ?
       JHE  OPND30            Yes
 
       CB   *R8,@SQUOTE       "'" ?
       JNE  OPND10
 
       DEC  R10               Toggle quote indicator
OPND10 ABS  R10               Check if even or odd # of quotes
       JNE  OPND20
 
       CB   *R8,R15           Blank ?
       JEQ  OPND30
 
       BL   @CNVLC8           UPCASE
       CB   *R8,@PERIOD       "." for "," is common typo
       JEQ  ASMERR            Bloop it
 
OPND20 INC  R8                Next char
       JMP  OPRND             Do it again
 
*  Check quotes on way out
 
OPND30 ABS R10                Uneven # of quotes
       JNE ASMERR             Sound the alarm
 
ASMCEX BLWP @UPDTLN           Update edit buffer
       B    *R14              Return
 
ASMERR BL   @HONK             Show displeasure
       JMP  ASMCEX            Don't do next to make more obvious still
 
*  Previous line-start align and insert new line
 
PRET10 EQU  $
       BL   @UPDT10           Current line to text buffer
PRTB10 BL   @>0               ENTRY writes in
       MOV  R8,R2             Use first non-blank position
       INC  R1                Next line - blank line re-entry
       B    @INSERU           Go insert blank and set cursor on it
 
PRED10 EQU  $
       MOV  R11,R14           Save return
PRTB20 BL   @>0               ENTRY writes in
       B    *R14              Ignore if non-blank
       B    @DELLIN           Delete the blank line
 
*  Check for blank line between margins
 
CHKBLK EQU  $
       MOV  @LMRG,R8          Start at left margin
CHBL10 MOV  @LINADR,R9        Current line buffer
       A    R8,R9             Index into line
       CB   *R9,@DSPACE       Search for non-blank
       JNE  CHBL20            Found
       INC  R8                Next char
       C    R8,@RMRG          Stop at right margin
       JL   CHBL10            Loop on it
       INCT R11               Step over for blank line
CHBL20 B    *R11              Non-blank line - direct return
 
 
ASMLEN EQU  $-ASMCOD          Length of replacement block
PRETTY EQU  PRET10-ASMCOD     Offset value for entry code
PREDEL EQU  PRED10-ASMCOD     Offset value for entry code
CHKBLM EQU  CHKBLK-ASMCOD     Offset value for entry code
PRDOF1 EQU  PREDEL-PRETTY
PRDOF2 EQU  CHKBLM-PREDEL
 
*----------------------------------------------
 
