{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-} {$M 16384,0,0} {Autor: mittlerweile diverse} unit folio; INTERFACE Type ScreenbufferType = Array [ 1 .. 320 ] Of Byte; {} Procedure RestoreScreen (buffer : ScreenbufferType ); {Gegenstck zu Savescreen} Procedure SaveScreen (Var buffer : ScreenbufferType ); {Speichert Bildschirm in Variable vom Typ Screenbuffertype.} Function Edit(xtl,ytl,width,startMode,boxType:Byte; maxLength,startpos:Word; EditorTitle,EditorPrompt:String; Var buffer:String):Boolean; {Line-Editor. Position xtl,ytl, Breite width. StartMode 0 nicht l”schen, 2 l”schen boxtype 255 keine, 0 einzeln, 1 doppelt maxlength maximale L„nge; startpos Startposition im Text, title Titel Prompt Prompt, Buffer Editiertext} procedure hotkey(state:boolean); {false schaltet die internen Programme ab. true wieder an.} function getspeed:byte; {Die folgende Routine ermittelt die ungef„hre Taktfrequenz des Portfolio und speichert sie in der Variablen getspeed. Das Ergebnis gibt die Taktfrequenz in Einheiten von 100kHz an: 49 = 4.9 MHz 65 = 6.5 MHz von Klaus Peichl} procedure errwin(x,y:byte;text:string); {Gibt text in Kasten aus, piepst, wartet auf Taste, stellt Bildschirminhalt wieder her. x und y: Position linke obere Ecke} procedure messagewin(x,y:byte;title,text:string); {Gibt Text mit Titel in Kasten aus. Mehrzeilige Texte mit #0 trennen. x, y linke obere Ecke.} procedure drawbox(x1,y1,x2,y2,line:byte); {Zeichnet Kasten. Line: 0 Einzellinie 1 Doppellinie} procedure setstatus(on:boolean;x,y:byte); {Setzt Statuszeile an (wenn on=true) Position x,y oder aus} procedure dial(number:string); {W„hlt den String, bestehend aus 0123456789ABCD*#. ACHTUNG UPPERCASE} procedure setcontrast(value:byte); {Stellt Bildschirmkontrast auf den Wert value} function getcontrast:byte; {Liefert den Momentanen Wert der Kontrasteinstellung zurck} function inccontrast(step:byte):byte; {Erh”ht Kontrast um step, soweit noch m”glich, liefert neuen Wert zurck.} function deccontrast(step:byte):byte; {Verringert Kontrast um step, soweit m”glich, liefert neuen Wert zurck.} PROCEDURE Refresh; { fhrt einen Bildschirm-Refresh durch, damit die Ver„nderungen nach dem direkten Schreiben in den Bildschirmspeicher sichtbar werden } procedure grefresh; {fhrt einen sehr schnellen Refresh im Grafikmodus (kein Text) aus. Funktioniert nicht mit dem PC-Emulator. Ausfhrungs- zeit etwa 1/10 sec} procedure setcursor(mode:byte); {Mode: 0-kein Cursor 1-Strich 2-Block 3-Force Mode(Anpassung an Numlock-Status)} procedure bank(mode:byte); {0:ROM 1:A: 2:B: 3:Externes Rom} {wird eingeblendet in C000:0000 bis E000:0000, zugreifen z.B. VAR Card:array[0..131072] of byte ABSOLUT $C000:0000} procedure alarm; {Erzeugt Alarmton, wartet auf Taste} procedure psound(length:word;code:byte); {Erzeugt Ton der L„nge length (in 10ms-Intervallen) mit Code code (siehe Technical Reference Guide)} procedure SetPower(mode:byte); {Mode: 0 -normal 1 -Batterie-Ersch”pft-Warnung zeigen, nicht abschalten 2 -Keine Reaktion bei leeren Batterien Vorsichtig und nur kurz (z.B. Speichern) verwenden !!!} function GetPower:byte; {Liefert SetPower-Modus zurck, siehe dort} procedure off; {Schaltet PoFo aus.} function IsAtari:boolean; {TRUE, wenn Atari-Taste gedrckt} function menu(x,y,depth,top,sel:byte;title,mtext,dtext:string):word; {x und y: Position depth: Tiefenberprfung. Dies gibt an, wie viele Zeilen das Men maximal belegt. top: Zeile, die im Men als erste (oben) steht. sel: Zeile, auf der der Cursor steht title: Titel des Mens mtext:Texte der Meneintr„ge, voneinander durch #0 getrennt. Beispiel: 'Menpunkt 1'+#0+'Punkt2' dtext: Zur Zeit auáer Funktion. Liefert Nummer des ausgew„hlten Punktes im Lowbyte und Nummer des in der ersten Zeile stehenden Punkts im Highbyte und -1 wenn ESC gedrckt.} IMPLEMENTATION uses dos; Type EditorControlStructure = Record ep_targ : Pointer; {} ep_pos : Word; {} ep_max : Word; {} ep_xpos : Byte; {} ep_ypos : Byte; {} ep_mode : Byte; {} ep_hit : Word; {} ep_tit : Pointer; {} ep_exit : Pointer; {} ep_fn : Pointer; {} ep_wid : Byte; {} ep_wind : Byte; {} ep_res : Longint; {} ep_udel : Pointer; {} End; const dip:array[0..6] of byte = (40,67,41,32,68,73,80); VAR r:registers; i:byte; Procedure RestoreScreen (buffer : ScreenbufferType ); Begin r.ah := $08; { Funktionsnummer } r.al := 2; { Subservice Restore characters only } r.bh := 0; { Allers andere ist wie bei SaveScreen } r.dl := 0; r.dh := 0; r.cl := 39; r.ch := 7; r.ds := Seg ( buffer ); r.si := Ofs ( buffer ); Intr ( $60, r ); End; Procedure SaveScreen (Var buffer : ScreenbufferType ); Begin r.ah := $08; { Funktionsnummer } r.al := 0; { Subservice Save Characters only } r.bh := 0; { Videopage number } r.dl := 0; { X- und Y-Position der linken-oberen Ecke } r.dh := 0; r.cl := 39; { X- und Y-Position der rechten-unteren Ecke } r.ch := 7; r.ds := Seg ( buffer ); { Adrresse des Speicherbereichs in den } r.si := Ofs ( buffer ); { gesichert werden soll } Intr ( $60, r ); End; {Editor-Hilfsroutinen} {$F+} procedure undel;assembler; asm end; procedure getkey; assembler; asm mov ah,0 int $16 test al,255 jz @ftaste mov ah,0 jmp @schluss @ftaste: mov al,ah mov ah,1 @schluss: end; {$F-} Function Edit(xtl,ytl,width,startMode,boxType:Byte; maxLength,startpos:Word; EditorTitle,EditorPrompt:String; Var buffer:String):Boolean; { Taste zum verlassen des Editors : ESC und Return } Const ExitCodes : Array [ 1 .. 3 ] Of Word = ( $001B, $000D, $0000 ); Var ecs : EditorControlStructure; returnChar, zaehler : Word; Begin buffer := buffer + #0; EditorTitle := EditorTitle + #0 +EditorPrompt + #0 + #0; ecs.ep_targ := Addr( buffer[ 1 ] ); { Adresse des Zeichenpuffers } ecs.ep_pos := startPos; { Position des Cursors ist des Textende } ecs.ep_max := maxLength; { maximale L„nge des editierten Strings } ecs.ep_xpos := xtl; { X-Koordinate des Fensters } ecs.ep_ypos := ytl; { Y-Koordinate des Fensters } ecs.ep_mode := startMode; { Startmodus 0 oder 2 } ecs.ep_hit := 0; { } ecs.ep_tit := Addr( EditorTitle[ 1 ] ); { Titel und Prompt zusammen } ecs.ep_exit := Addr( ExitCodes[ 1 ] ); { als Konstante oben deklariert } ecs.ep_fn := Addr( getkey ); { immer so} ecs.ep_wid := width; { wird oben berechnet } ecs.ep_wind := boxType; { double line box } ecs.ep_res := 0; { immer so } ecs.ep_udel := Addr( undel ); { immer so } r.ah := 1; r.ds := Seg( ecs ); r.si := Ofs( ecs ); Intr( $60, r ); returnChar := r.ax; Edit := True; { die Funktion liefert TRUE zurck ... } If returnChar = $001B Then { oder FALSE wenn der Editor mit ESC beendet wurde } Edit:= False; buffer[ 0 ] := #0; { Stringl„nge auf Null setzen } zaehler := 1; { Zeichenz„hler auf Eins setzen } While buffer[ zaehler ] <> #0 Do { so lange kein Nullzeichen auftaucht } Begin Inc( buffer[ 0 ] ); { Stringl„nge um eins erh”hen } Inc( zaehler ); { zaehler um eins erh”hen } End; End; procedure hotkey(state:boolean); begin if state=false then begin ASM push ds mov ax,2200h int 61h mov Byte Ptr ds:10ch,1 pop ds end; end else begin ASM push ds mov ax,2200h int 61h mov Byte Ptr ds:10ch,0 pop ds end; end; end; function getspeed:byte; var cspeed:byte; begin ASM mov dx,8040h @warte_auf_High: in al,dx test al,1 jz @warte_auf_High @warte_auf_Low: in al,dx test al,1 jnz @warte_auf_Low xor cx,cx @warte_auf_High2: in al,dx inc cx mov ah,6 @Timeloop: dec ah jnz @Timeloop test al,1 jz @warte_auf_High2 mov cspeed,ch end; getspeed:=cspeed; end; procedure drawbox(x1,y1,x2,y2,line:byte); begin r.ah:=9; r.al:=line; r.bh:=0; r.ch:=y2; r.cl:=x2; r.dh:=y1; r.dl:=x1; intr($60,r); end; procedure errwin(x,y:byte;text:string); var text2:string; begin r.bh:=0; r.dh:=y; r.dl:=x; r.cx:=1; r.ah:=$14; text2:=text+#0+#0; r.ds:=seg(text2); r.si:=ofs(text2)+1; intr($60,r); end; procedure messagewin(x,y:byte;title,text:string); var text2:string; begin text2:=title+#0+text+#0+#0; r.ah:=$12; r.bh:=0; r.dh:=y; r.dl:=x; r.ds:=seg(text2); r.si:=ofs(text2)+1; intr($60,r); end; procedure setstatus(on:boolean;x,y:byte); begin r.ah:=$2e; if on then r.al:=1 else r.al:=0; r.dh:=y; r.dl:=x; intr($61,r); end; procedure dial(number:string); begin r.ah:=$17; r.ds:=seg(number); r.si:=ofs(number); r.cx:=length(number); intr($61,r); end; function inccontrast(step:byte):byte; begin if 255-port[$8060]=port[$8060] then port[$8060]:=0 else port[$8060]:=port[$8060]-step; deccontrast:=port[$8060]; end; procedure setcontrast(value:byte); begin port[$8060]:=value; end; function getcontrast:byte; begin getcontrast:=port[$8060]; end; PROCEDURE Refresh ;assembler; asm mov ah,$12 int $61 end; procedure grefresh;assembler; ASM jmp @Befehle @Flip2Low: DB 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15 @Flip2High: DB 0,128,64,192,32,160,96,224,16,144,80,208,48,176,112,240 @Befehle: cli mov al,0ah { Cursoradresse Low setzen } mov dx,8011h out dx,al {nop} push bp mov ax,0b000h dec dx out dx,al {nop} push ds mov ds,ax mov al,0bh { Cursoradresse High setzen } inc dx out dx,al {nop} xor bh,bh mov di,Offset @Flip2High cld dec dx mov al,0 { Highbyte} out dx,al {nop} mov bp,0F0Fh xor si,si inc dx mov al,0ch { Daten ank=81ndigen } out dx,al dec dx @refresh: lodsw mov cx,ax ror cx,1 ror cx,1 ror cx,1 ror cx,1 and ax,bp and cx,bp mov bl,al mov al,Byte Ptr[cs:di+bx] mov bl,cl or al,Byte Ptr[@Flip2Low+bx] out dx,al mov bl,ah mov al,Byte Ptr[cs:di+bx] mov bl,ch or al,Byte Ptr[@Flip2Low+bx] out dx,al cmp si,1920 jne @refresh sti pop ds pop bp end; procedure setcursor(mode:byte); begin r.ah:=$f; if mode=3 then r.al:=2 else r.al:=1; r.bl:=mode; intr($61,r); end; procedure bank(mode:byte); begin r.ah:=$24; r.al:=1; r.dl:=mode; r.dh:=mode; intr($61,r); end; procedure alarm; begin r.ah:=$15; r.al:=2; intr($61,r); end; procedure psound(length:word;code:byte); begin r.ah:=$16; r.cx:=length; r.dl:=code; intr($61,r); end; procedure setpower(mode:BYTE); begin r.ah:=$26; r.al:=1; r.dl:=mode; intr($61,r); end; function getpower:byte; begin r.ah:=$26; r.al:=0; intr($61,r); getpower:=r.dl; end; procedure off; begin r.ah:=$2d; intr($61,r); end; function isatari:boolean; begin r.ah:=$2f; intr($61,r); if r.al=$20 then isatari:=true else isatari:=false; end; function menu(x,y,depth,top,sel:byte;title,mtext,dtext:string):word; var defstr,tempstr:string; begin tempstr:=title+#0+mtext+#0+#0; defstr:=dtext+#0+#0; with r do begin; al:=1+8*depth; ah:=$f; bh:=0; ch:=top; cl:=sel; dl:=x; dh:=y; ds:=seg(tempstr); si:=ofs(tempstr)+1; (*es:=seg(defstr); di:=ofs(defstr)+1;*) es:=$ff; di:=$ff; end; intr($60,r); menu:=r.ax; end; BEGIN for i:=0 to 6 do if mem[$F000:$FFE6+i]<>dip[i] then begin writeln('Dieser Computer ist nicht Portfolio-kompatibel.'); halt(1); end; r.ah:=0; intr($61,r); END.