Phoebus R. Dokos writes:
>Hmmm another undocumented feature... nothing
> in the SMS reference manual
> :-) Or at least I didn't see it. Thanks Richard
No, but it is in the Qptr manual - a must for writing PE programs! Is it
still available (Jochen)?
Per
Below is a small S*Basic program to document the (PE) scr/con Channel
Definition
Block (cdb). Requires TK2 and the chans toolkit by SNG (DIY TK C) or
similar. For documentation RTFC, otherwise just LRUN.
<---------------------------------------------------------------------------
----------------------------->
100 ch=0:p%=1:prt%=0: rem ch is Qdos channel no to inspect
110 tab0=0:tab1=9:tab2=18
120 IF prt%=0 THEN
130 lines%=CHAN_W%(#p%;78)/CHAN_W%(#p%;88)-1
140 CLS#p%
150 ELSE
160 tab0=6:tab1=tab1+14:tab2=tab2+14
170 INPUT'Hardcopy <BREAK> to quit'!x$
180 lines%=66
190 p%=FOPEN('prt')
200 END IF
210 cline%=2
220 DoIt
230 IF prt%:BPUT#3;12:CLOSE#p%:p%=1
240 :
250 DEFine PROCedure DoIt
260 primary%=CHAN_B%(#ch;65)&&128
270 managed%=CHAN_B%(#ch;65)&&1
280 PRINT#p%;TO tab0;'Channel#';HEX$(ch,32)!'is a ';
290 IF NOT managed%:PRINT#p%;'un';
300 PRINT#p%;'managed ';
310 IF primary%:PRINT#p%;'PRIMARY':ELSE :PRINT#p%;'SECONDARY'
320 CHAN 4,0,'chn_len','length channel block'
330 CHAN 4,4,'chn_drvr','addr driver linkage'
340 CHAN 4,8,'chn_ownr','owner of channel'
350 CHAN 4,12,'chn_rflg','� chan closed flag'
360 CHAN 2,16,'chn_tag','tag'
370 CHAN 1,18,'chn_stat','$ff wait,$80 (a1,a6)'
380 CHAN 1,19,'chn_actn','IO action'
390 CHAN 4,20,'chn_jbwt','job waiting for IO'
400 CHAN 2,24,'sd_xhits','x hit size'
410 CHAN 2,26,'sd_yhits','y hit size'
420 CHAN 2,28,'sd_xhito','x hit origen SC'
430 CHAN 2,30,'sd_yhito','y hit origen SC'
440 CHAN 2,32,'sd_xouts','x outline size'
450 CHAN 2,34,'sd_youts','y outline size'
460 CHAN 2,36,'sd_xouto','x outline origen SC'
470 CHAN 2,38,'sd_youto','y outline origen SC'
480 IF primary% THEN
490 CHAN 4,40,'sd_prwlb','primary link list �'
500 ELSE
510 CHAN 4,40,'sd_pprwn','pointer to primary'
520 END IF
530 CHAN 4,44,'sd_prwlt','primary link list �'
540 CHAN 4,48,'sd_sewll','� secondary link list'
550 CHAN 4,52,'sd_wsave','window save area base'
560 CHAN 4,56,'sd_wssiz','size of window save'
570 CHAN 4,60,'sd_wwdef','� working definition'
580 CHAN 1,64,'sd_wlstt','lock status'
590 CHAN 1,65,'sd_prwin','primary/managed'
600 CHAN 1,66,'sd_wmode','mode 0/8'
610 CHAN 1,67,'sd_mysav','save area mine flag'
620 CHAN 1,68,'sd_wmove','move/query flag'
630 CHAN 1,69,'?','spare?'
640 CHAN 2,70,'?','spare?'
650 CHAN 2,72,'sd_xmin','window top LHS'
660 CHAN 2,74,'sd_ymin','window top LHS'
670 CHAN 2,76,'sd_xsize','size in pixels'
680 CHAN 2,78,'sd_ysize','size in pixels'
690 CHAN 2,80,'sd_bordw','border width'
700 CHAN 2,82,'sd_xpos','cursor position'
710 CHAN 2,84,'sd_ypos','cursor position'
720 CHAN 2,86,'sd_xinc','cursor increment'
730 CHAN 2,88,'sd_yinc','cursor increment'
740 CHAN 4,90,'sd_font','first font address'
750 CHAN 4,94,'sd_font','second font address'
760 CHAN 4,98,'sd_srcb','screen base'
770 CHAN 4,102,'sd_pmask','paper colour mask'
780 CHAN 4,106,'sd_smask','strip colour mask'
790 CHAN 4,110,'sd_imask','ink colour mask'
800 CHAN 1,114,'sd_cattr','char attributes'
810 CHAN 1,115,'sd_curf','cursor flag 0=off'
820 CHAN 1,116,'sd_pcolr','paper colour byte'
830 CHAN 1,117,'sd_scolr','strip colour byte'
840 CHAN 1,118,'sd_icolr','ink colour byte'
850 CHAN 1,119,'sd_bcolr','border colour byte'
860 CHAN 1,120,'sd_nlsta','newline status'
870 CHAN 1,121,'sd_fmod','fill mode 1=on'
880 CHAN 6,122,'sd_yorg','graphics orig (QL)'
890 CHAN 6,128,'sd_xorg','graphics orig (QL)'
900 CHAN 6,134,'sd_scal','graphics scale (QL)'
910 CHAN 4,140,'sd_fbuf','� fill buffer'
920 CHAN 4,144,'sd_fuse','�UD fill vectors(QL)'
930 CHAN 2,148,'sd_linel','line len in bytes'
940 IF CHAN_L(#ch;152)=0:PRINT#p%;'End for SCReen':STOP
950 PRINT#p%;TO tab0;'CONsole. Queue details follow':cline%=cline%+1
960 CHAN 1,152,'q_eoff','MSB set if eof'
970 CHAN 4,152,'q_nextq','link to next queue'
980 CHAN 4,156,'q_end','� end of queue'
990 CHAN 4,160,'q_nextin','� put next byte here'
1000 CHAN 4,164,'q_nxtout','� get next byte here'
1010 IF NOT prt% THEN
1020 PRINT#p%:st=CHAN_L(#ch;164):en=CHAN_L(#ch;156)
1030 FOR i=st TO en:PRINT#p%;CHR$(PEEK(i));
1040 END IF
1050 END DEFine
1060 :
1070 DEFine PROCedure CHAN(l,ad,t1$,t2$)
1080 IF cline%>lines% THEN
1090 cline%=2
1100 IF NOT prt% THEN
1110 PRINT#p%;'Press any key to
continue...':PAUSE:AT#p%;1,0:CLS#p%;3:CLS#p%;2
1120 ELSE
1130 BPUT#p%;12
1140 END IF
1150 END IF
1160 cline%=cline%+1
1170 IF prt% THEN
1180 IF ad<24 THEN
1190 ad1$=HEX$(ad,8)
1200 ELSE
1210 IF ad>=24 AND ad<72 THEN
1220 ad1$=HEX$(ABS(ad-48),8)
1230 IF (ad-48)<0:ad1$='-'&ad1$
1240 ELSE
1250 ad1$=HEX$(ad-72,8)
1260 END IF
1270 END IF
1280 IF ad1$(1)<>'-':ad1$=' '&ad1$
1290 ad$=HEX$(ABS(ad),8)
1300 IF ad<0:ad$='-'&ad$:tab0=5:ELSE :tab0=6
1310 PRINT#p%;TO tab0;ad1$!ad$;' ';
1320 END IF
1330 IF l=1:PRINT#p%;t1$;TO tab1;BIN$(CHAN_B%(#ch;ad),8);TO
tab2;'.b'!t2$:RETurn
1340 IF l=2:PRINT#p%;t1$;TO tab1;CHAN_W%(#ch;ad);TO tab2;'.w'!t2$:RETurn
1350 IF l=4:PRINT#p%;t1$;TO tab1;HEX$(CHAN_L(#ch;ad),32);TO
tab2;'.l'!t2$:RETurn
1360 IF l=6:PRINT#p%;t1$;TO tab1;FLT(CHAN_W%(#ch;ad),CHAN_L(#ch;ad+2));TO
tab2;'.f'!t2$
1370 END DEFine
1380 :
1390 DEFine FuNction FLT(x,b)
1400 IF b=0 OR x=0:RETurn 0
1410 RETurn b*2^(x-2079)
1420 END DEFine
1430 :
<---------------------------------------------------------------------------
----------------------------->
