|
unit stringhe; (**********************) interface (****************************) uses crt,dos; TYPE PSchermo=^TipoSchermo; TipoSchermo=array[1..25,1..80] of record ch:char; at:byte; end; (*array identico alla memoria video*) Pfinestra=^finestra; finestra=record schermo:TipoSchermo; prox,prec:Pfinestra; end; (*lista doppia che andr… a memorizzare le schermate*) string20=string[20]; STRING80=STRING[80]; var video:PSchermo; seg_vid:word; corrente,precedente,successivo,ultimo,primo:Pfinestra; procedure cursore(ch:char); (*spegne e attiva il cursore*) procedure fissa_car_col(x,y:byte;ch:char;fg,bg:byte); (*fissa carattere,colore testo e colore sfondo in una word della memoria video *) procedure str_vid(x,y:byte;str:string80;fg,bg:byte); (*fissa una stringa con colore testo e sfondo direttamente in memoria video*) procedure pulisci(x1,y1,x2,y2,colore_testo,colore_sfondo:byte); (*riempie una finestra con spazi ' ' in memoria video, fissando i colori di testo e sfondo*) procedure cornice(x1,x2,y1,y2,fg,bg:byte;s1,s2,s3,s4,s5,s6:char); (*disegna la cornice alle finestre, fissando i colori di sfondo e testo*) procedure punt_avanti; (*memorizza ultima schermata*) procedure punt_indietro; (*ritorno alla schermata precedente*) procedure azzera_punt_video; (*azzera lista puntatori*) (********************) IMPLEMENTATION (********************) procedure cursore(ch:char); var regs:registers; begin regs.AH:=$01; case ch of 'S':begin regs.CH:=$20; regs.CL:=$20; end; (*cursore spento*) 'G':begin regs.CH:=$3; regs.CL:=$7; end; (*cursore grosso*) 'P':begin regs.CH:=$6; regs.CL:=$7; end; (*cursore piccolo*) end; intr($10,regs); end; {*************} procedure fissa_car_col(x,y:byte;ch:char;fg,bg:byte); var w:word; attrib:word; begin w:=((y-1)*80+(x-1))*2; attrib:=(bg shl 4)+ fg; memW[seg_vid:W]:=(attrib shl 8)+ ord(ch); end; {***************} procedure str_vid(x,y:byte;str:string80;fg,bg:byte); var i:byte; begin if str='' then exit; for i:=1 to (length(str)) do fissa_car_col(x+i-1,y,str[i],fg,bg); end; {***************} procedure pulisci(x1,y1,x2,y2,colore_testo,colore_sfondo:byte); var i,j:byte; begin for i:=y1 to y2 do for j:=x1 to x2 do fissa_car_col(j,i,' ',colore_testo,colore_sfondo); end; {*******************} procedure cornice(x1,x2,y1,y2,fg,bg:byte;s1,s2,s3,s4,s5,s6:char); var i:byte; begin for i:=x1+1 to x2-1 do begin fissa_car_col(i,y1,s5,fg,bg); fissa_car_col(i,y2,s5,fg,bg); end; for i:=y1+1 to y2-1 do begin fissa_car_col(x1,i,s6,fg,bg); fissa_car_col(x2,i,s6,fg,bg); end; fissa_car_col(x1,y1,s1,fg,bg); fissa_car_col(x2,y1,s2,fg,bg); fissa_car_col(x1,y2,s3,fg,bg); fissa_car_col(x2,y2,s4,fg,bg); end; {*******************} procedure punt_avanti; begin if primo=nil then begin new(corrente); primo:=corrente; ultimo:=corrente; corrente^.prox:=nil; corrente^.schermo:=video^; end else begin precedente:=corrente; new(corrente); precedente^.prox:=corrente; ultimo:=corrente; corrente^.prox:=nil; ultimo^.prec:=precedente; corrente^.schermo:=video^; end; end; procedure punt_indietro; begin if ultimo <> primo then begin corrente:=ultimo; ultimo:=corrente^.prec; dispose(corrente); corrente:=ultimo; video^:=corrente^.schermo; end; end; procedure azzera_punt_video; begin if primo=nil then exit; corrente:=primo; while corrente<>nil do begin precedente:=corrente^.prox; dispose(corrente); corrente:=precedente; end; primo:=nil; end; begin if mem[$0000:$0449]=7 then seg_vid:=$B000 else seg_vid:=$B800; {video bianco e nero o colori} new(video); video:=ptr(seg_vid,$0000); primo:=nil; end.
|
|
