Package KbdCRT

Interface

Const
     False,True
Type
    Boolean is Byte

Const
     Nil=Pointer(&HFFFF,&HFFFF)
Type
    String is @Array[0..&HFF] Of Byte

Def ScaSB(Ptr as Pointer,V as Byte,N as Word) as Word
Sub StoSB(Ptr as Pointer,V as Byte,N as Word)
Sub StoSW(Ptr as Pointer; V,N as Word)
Sub MovSB0(Src,Dest as Pointer; N as Word)
Sub MovSB(Src,Dest as Pointer; N as Word)

\ T_CTRL(x)     (x-'@')
  T_F(n)        (0x3a00+0x100*n)
  T_ALT_F(n)    (0x6700+0x100*n)
  T_CTRL_F(n)   (0x5d00+0x100*n) \
Const
   \ Codes de base \
     T_CR=&HD
     T_BS=&H8
     T_TAB=&H9
     T_CTRL_CR=&HA
     T_ESC=&H1B
     T_CTRL_I='I'-'@'
     T_CTRL_K='K'-'@'
     T_CTRL_B='B'-'@'
     T_CTRL_C='C'-'@'
     T_CTRL_V='V'-'@'
     T_CTRL_Y='Y'-'@'
     T_CTRL_Q='Q'-'@'
   \ Codes ‚tendus \
     T_RIGHT=&H4D
     T_LEFT=&H4B
     T_UP=&H48
     T_DOWN=&H50
     T_HOME=&H47
     T_END=&H4F
     T_PGUP=&H49
     T_PGDWN=&H51
     T_INS=&H52
     T_DEL=&H53
     T_CTRL_RIGHT=&H74
     T_CTRL_LEFT=&H73
     T_CTRL_HOME=&H77
     T_CTRL_END=&H75
     T_CTRL_PGUP=&H84
     T_CTRL_PGDWN=&H76
     T_ALT_C=&H2E
     T_ALT_R=&H13
     T_ALT_Q=&H10
     T_F1=&H3B
     T_F2=&H3C
     T_F3=&H3D

Def GetCar as Word
Sub LineInput(S as String)

Const
     Text40x25,Text80x25,Text132x60,LastCRTMode
Var
   Screen as @Array[0..132*60-1] Of Word
   NbLig,NbCol as Word
   CursShape as Word
   Li,Col as Word
   Color as Byte

Sub SetCRTMode(M as Byte)

Sub SetCursShape(S as Word)
Def GetCurPos as Word
Sub Locate(NewLi,NewCol as Word)

Sub ClearScreen
Sub ClrEOL
Sub SetColorLine(Li as Word,C as Byte)
Sub SetColor(C as Byte)

Sub PutCar(C As Byte)
Sub PrintCR
Sub PrintSX(B As Byte)
Sub PrintX(I As Word)
Sub PrintLX(I As LongWord)
Sub PrintD(I as Int)
Sub PrintS(S as String)

Sub StrCpy(S1,S2 as String)
Def StrEQ(S1,S2 as String) as Boolean
Sub Concat(R,S1,S2 as String)
Sub UpCaseString(S as String)

Implementation

\
  Machine access util
                      \
Def ScaSB(Ptr as Pointer,V as Byte,N as Word) as Word
Enter
\ CLD \
  InLine(&HFC)
\ LES DI,[Ptr] \
  InLine(&HC4,&HBE,Ptr)
\ MOV AL,[V] \
  InLine(&H8A,&H86,V)
\ MOV CX,[N] \
  InLine(&H8B,&H8E,N)
\ REPNZ SCASW \
  InLine(&HF2,&HAE)
\ MOV Result,CX \
  InLine(&H89,&H8E,Result)
Leave

Sub StoSB(Ptr as Pointer,V as Byte,N as Word)
Enter
\ CLD \
  InLine(&HFC)
\ LES DI,[Ptr] \
  InLine(&HC4,&HBE,Ptr)
\ MOV AL,[V] \
  InLine(&H8A,&H86,V)
\ MOV CX,[N] \
  InLine(&H8B,&H8E,N)
\ REPZ STOSB \
  InLine(&HF3,&HAA)
Leave

Sub StoSW(Ptr as Pointer; V,N as Word)
Enter
\ CLD \
  InLine(&HFC)
\ LES DI,[Ptr] \
  InLine(&HC4,&HBE,Ptr)
\ MOV AX,[V] \
  InLine(&H8B,&H86,V)
\ MOV CX,[N] \
  InLine(&H8B,&H8E,N)
\ REPZ STOSW \
  InLine(&HF3,&HAB)
Leave

Sub MovSB0(Src,Dest as Pointer; N as Word)
Enter
\ CLD \
  InLine(&HFC)
\ PUSH DS \
  InLine(&H1E)
\ LES SI,[Src] \
  InLine(&HC4,&HB6,Src)
\ MOV BX,ES \
  InLine(&H8C,&HC3)
\ MOV DS,BX \
  InLine(&H8E,&HDB)
\ LES DI,[Dest] \
  InLine(&HC4,&HBE,Dest)
\ MOV CX,[N] \
  InLine(&H8B,&H8E,N)
\ REPZ MOVSB \
  InLine(&HF3,&HA4)
\ POP DS \
  InLine(&H1F)
Leave

Sub MovSB(Src,Dest as Pointer; N as Word)
  OfsS,OfsD as LongWord
Enter
\ Mˆmes segments \
  If LongWord(Src) & &HFFFF0000=LongWord(Dest) & &HFFFF0000 Then
  \ Pas de d‚bordement \
    OfsS=Low(Src)
    OfsD=Low(Dest)
    If (OfsS+N<=&HFFFF) And (OfsD+N<=&HFFFF) Then
    \ Choix direction \
      If OfsS>OfsD Then
      \ CLD \
        InLine(&HFC)
      Else
      \ Se placer … la fin des deux blocs \
        Low(Src)+=N-1
        Low(Dest)+=N-1
      \ STD \
        InLine(&HFD)
      End
    \ PUSH DS \
      InLine(&H1E)
    \ LES SI,[Src] \
      InLine(&HC4,&HB6,Src)
    \ MOV BX,ES \
      InLine(&H8C,&HC3)
    \ MOV DS,BX \
      InLine(&H8E,&HDB)
    \ LES DI,[Dest] \
      InLine(&HC4,&HBE,Dest)
    \ MOV CX,[N] \
      InLine(&H8B,&H8E,N)
    \ REPZ MOVSB \
      InLine(&HF3,&HA4)
    \ POP DS \
      InLine(&H1F)
    End
  End
Leave

\
  Clavier
          \
Def GetCar as Word
Enter
  AX=0
  InLine(&HCD,&H16)
  Result=AX
  If Low(Result)<>0 Then Result&=&HFF;
Leave

Sub LineInput(S as String)
Enter
\ Init S[0] \
  S[0]=254
\ PUSH DS \
  InLine(&H1E)
\ LES DI,[@S] \
  InLine(&HC4,&HBE,S)
  BX=ES:DS=BX
  DX=DI
  AX=&H0A00
  InLine &H21CD
\ POP DS \
  InLine(&H1F)
\ Mise de la chaŒne au bon format \
  MovSB0(@S[1],@S[0],S[1]+1)
Leave

\
  CRT Modes
            \
Type
    Record CRTModeDescr is
      NbLig,NbCol as Byte
      Screen as Pointer
      BIOSAX as Byte
    End
Var
   Descr as Array[0..LastCRTMode-1] Of CRTModeDescr

Sub SetCRTMode(M as Byte)
Enter
  If M<LastCRTMode Then
    NbLig=Descr[M].NbLig
    NbCol=Descr[M].NbCol
    @Screen=Descr[M].Screen
    AX=Descr[M].BIOSAX
    InLine &H10CD
    Li=Col=1
    Color=7
  End
Leave

\
  Curseur
          \
Sub SetCursShape(S as Word)
Enter
  AX=&H100
  CX=S
  InLine(&HCD,&H10)
Leave

Def GetCurPos as Word
Enter
  AX=&H0300
  BX=0
  InLine(&HCD,&H10)
\ AprŠs ‡a, (DH,DL)=(Li,Col) \
  Result=DX
Leave

Sub Locate(NewLi,NewCol as Word)
Enter
  Li=NewLi:Col=NewCol
  DX=(Li-1)<<8+Col-1
  BX=0
  AX=&H0200
  InLine(&HCD,&H10)
Leave

\
  Miscellaneous
                \
Sub ClearScreen
Enter
  StoSW(@Screen,(Color,&H20),NbLig*NbCol)
  Li=Col=1
  Locate 1,1
Leave

Sub ClrEOL
Enter
  StoSW(@Screen[(Li-1)*NbCol+Col-1],(Color,' '),NbCol-Col+1)
Leave

Sub SetColorLine(Li as Word,C as Byte)
  Col as Word
Enter
  For Col=1 To NbCol Do
    Screen[(Li-1)*NbCol+Col-1]=(C,Low(Screen[(Li-1)*NbCol+Col-1]));
Leave

Sub ScrollUpScreen
Enter
  MovSB(Pointer(High(@Screen),Low(@Screen)+NbCol*2),@Screen,(NbLig-1)*NbCol*2)
  StoSW(Pointer(High(@Screen),Low(@Screen)+(NbLig-1)*NbCol*2),(Color,' '),NbCol)
Leave

\
  Couleur
          \
Sub SetColor(C as Byte)
Enter
  Color=C
Leave

\
  Affichages
             \
Sub PutCar(C as Byte)
  W as Word
Enter
  Screen[(Li-1)*NbCol+Col-1]=(Color,C)
  Col+=1
  If Col>NbCol Then
    Col=1
    If Li=NbLig Then ScrollUpScreen Else Li+=1;
  End
\ MAJ pos curseur \
  Locate Li,Col
Leave

Sub PrintCR
Enter
  Col=1
  If Li=NbLig Then ScrollUpScreen Else Li+=1;
  Locate Li,Col
Leave

Var
   Digit as Array[0..&HF] Of Byte

Sub PrintSX(B As Byte)
Enter
  PutCar Digit[B>>4]
  PutCar Digit[B&&HF]
Leave

Sub PrintX(I As Word)
Enter
  PutCar Digit[I>>12]
  PutCar Digit[High(I)&&HF]
  PutCar Digit[Low(I)>>4]
  PutCar Digit[I&&HF]
Leave

Sub PrintLX(I As LongWord)
Enter
  PrintX High(I)
  PrintX Low(I)
Leave

Sub PrintD(I as Int)
Static
      B as Array[0..50] Of Byte
Var
   BPtr as Int
Enter
  If I<0 Then PutCar '-':I=-I;
  BPtr=0
  While I<>0 Do
    B[BPtr]=I%10
    BPtr+=1
    I/=10
  Wend
  If BPtr=0 Then PutCar '0'
  Else
    Always
      BPtr-=1
      PutCar B[BPtr]+'0'
    AWhile
      BPtr<>0
    Do
    ;
Leave

Sub PrintS(S as String)
Var
   B as Byte
Enter
  For B=1 To S[0] Do PutCar(S[B]);
Leave

\
  Calc string
              \
Sub StrCpy(S1,S2 as String)
Enter
\ MovSB0(Source,Dest as Pointer; Len as Word)
  Len est une longueur compt‚e en octets. \
  MovSB0(@S2,@S1,Word(S2[0])+1)
Leave

Def StrEQ(S1,S2 as String) as Boolean
  I as Word
Enter
  If S1[0]<>S2[0] Then Result=False
  Else
    Result=True
    For I=1 To S1[0] Do If S1[I]<>S2[I] Then Result=False;
  End
Leave

Sub Concat(R,S1,S2 as String)
  I as Word
Enter
  For I=1 To S1[0] Do R[I]=S1[I];
  For I=1 To S2[0] Do R[I+S1[0]]=S2[I];
  R[0]=S1[0]+S2[0]
Leave

Sub UpCaseString(S as String)
Var
   I as Byte
Enter
  For I=1 To S[0] Do If S[I]>='a' And S[I]<='z' Then S[I]+='A'-'a';
Leave

Enter
\ Init Modes \
  Descr[Text40x25].NbLig=25
  Descr[Text40x25].NbCol=40
  Descr[Text40x25].Screen=Pointer(&HB800,&H0000)
  Descr[Text40x25].BIOSAX=1
  Descr[Text80x25].NbLig=25
  Descr[Text80x25].NbCol=80
  Descr[Text80x25].Screen=Pointer(&HB800,&H0000)
  Descr[Text80x25].BIOSAX=3
  Descr[Text132x60].NbLig=60
  Descr[Text132x60].NbCol=132
  Descr[Text132x60].Screen=Pointer(&HB800,&H0000)
  Descr[Text132x60].BIOSAX=&H4F
\ Init Digit \
  Digit[0]='0':Digit[4]='4':Digit[8]='8' :Digit[12]='C'
  Digit[1]='1':Digit[5]='5':Digit[9]='9' :Digit[13]='D'
  Digit[2]='2':Digit[6]='6':Digit[10]='A':Digit[14]='E'
  Digit[3]='3':Digit[7]='7':Digit[11]='B':Digit[15]='F'
\ Init CRTMode (c'est plus prudent...) \
  SetCRTMode Text80x25
  PrintS "KbdCRT start done":PrintCR
Leave