| $! PROMPT.COM
$!
$! 20-SEP-1988 W.Hickson
$!
$! Set the prompt string on a VT300 to a graphics image.
$! Two parameters
$! P1 - required input file describing desired prompt image
$! P2 - optional output file to capture commands defining prompt
$!
$! The image is described in a seperate file which contains a
$! matrix of the pixels making up the image. The file is a regular
$! file as produced by an editor with each record being a row in the
$! matrix and the characters in the records making up the columns.
$! An "X" (upper case) indicates a pixel that should be "on" and any
$! other character indicates on "off" pixel. The only limitation
$! on size is that the final prompt string must be less than the VMS
$! limit (32 with V4.7). The matrix will be divided up into "cells"
$! of width 10 and heigth 20. Each of these will count as one character
$! and there are some control characters which are added by this
$! procedure. This effectively limits the size of the matrix to
$! about 40 wide by 40 high. The exact formula is number_of_cells
$! + 2*(round_up(height/20)) + 17 <= 32. A hint for designing the
$! prompt is to do it on graph paper first and then transfer it to
$! a file as it looks distorted (tall & narrow) in the editor.
$! A second file can be specified (P2) to receive the commands
$! generated to set the prompt. This will cut down on the time needed
$! to set the prompt in the future as this routine takes several seconds
$! to run.
$ start:
$! get the file containing the prompt pixel description
$ if p1 .eqs. "" then inquire p1 "input file"
$ if p1 .eqs. "" then goto start
$ open/read prompt_file 'p1
$! if they ask for it, open an output file for the final commands
$ if p2 .nes. "" then open/write output_file 'p2
$ gosub define_ctl_characters
$ prompt_string = bold + scs + so
$ prompt_character_count = 3
$ main_loop:
$ string_1 = ""
$ string_2 = ""
$ string_3 = ""
$ string_4 = ""
$ prompt_string_build:
$ string_count = 1
$ gosub collect_sixels
$ gosub arrange_sixels
$! not eof means they'll need another row of character cells in prompt
$ if .not. eof_flag then prompt_string = prompt_string + cr + lf
$ if .not. eof_flag then goto main_loop
$ prompt_string = prompt_string + scs + si + off + " "
$ set prompt = "''prompt_string'"
$ if p2 .nes. "" then write output_file -
"set prompt = ""''prompt_string'"""
$ close prompt_file
$ if p2 .nes. "" then close output_file
$ exit
$!************************************************************************
$ define_ctl_characters:
$! define some needed control characters
$ esc[0,8] = 27
$ dcs[0,8] = 144
$ st[0,8] = 156
$ so[0,8] = 14
$ si[0,8] = 15
$ cr[0,8] = 13
$ lf[0,8] = 10
$ bold = "''esc'[1m"
$ off = "''esc'[0m"
$ scs = "''esc')1"
$ return
$!************************************************************************
$ collect_sixels:
$! Collect all of the sixels which will make up the first line
$! of characters in the prompt.
$ character_string = ""
$ gosub build_sixel_string
$ if string_count .eq. 1 then string_1 = character_string
$ if string_count .eq. 2 then string_2 = character_string
$ if string_count .eq. 3 then string_3 = character_string
$ if string_count .eq. 4 then string_4 = character_string
$ string_count = string_count + 1
$ if .not. eof_flag .and. string_count .lt. 5 then -
goto collect_sixels
$ return
$!***********************************************************************
$ arrange_sixels:
$! Arrange the sixels into characters and store these characters
$! in a soft character set.
$ prompt_character = dcs + "1;" + f$string(prompt_character_count) -
+ ";1;10;1;2;20;0{1"
$ first_pass = 1
$ more_string_flag = 0
$ string = string_1
$ gosub prompt_character_build
$ string_1 = string
$ string = string_2
$ gosub prompt_character_build
$ string_2 = string
$ string = string_3
$ gosub prompt_character_build
$ string_3 = string
$ string = string_4
$ gosub prompt_character_build
$ string_4 = string
$ prompt_character = prompt_character + st
$ write sys$output prompt_character
$ if p2 .nes. "" then write output_file -
"write sys$output ""''prompt_character'"""
$ prompt_ascii_character[0,8] = prompt_character_count + 32
$ prompt_string = prompt_string + prompt_ascii_character
$ prompt_character_count = prompt_character_count + 1
$ if more_string_flag then goto arrange_sixels
$ return
$!************************************************************************
$ prompt_character_build:
$! Pad 'string' out so that it is at least 10 characters long
$! and append a '/' and the first 10 characters of 'string' to
$! 'prompt_character'. Strip these same 10 characters off 'string'.
$! If this is the first time 10 characters are being appended to
$! 'prompt_character' skip the '/'.
$ string_length = f$length(string)
$ if string_length .lt. 10 then string = string + "?"
$ if string_length .lt. 10 then goto prompt_character_build
$ if string_length .gt. 10 then more_string_flag = 1
$ if first_pass then prompt_character = -
prompt_character + f$extract(0,10,string)
$ if .not. first_pass then prompt_character = -
prompt_character + "/" + f$extract(0,10,string)
$ first_pass = 0
$ string = f$extract(10,string_length-10,string)
$ return
$!*************************************************************************
$ build_sixel_string:
$! read six lines from the picture file and translate them into
$! a string of characters representing a string of sixels.
$! Store this string in 'character_string'
$! If the end of file is reached set 'eof_flag' to 1.
$! If this is the 4th set of six lines only read the first two lines
$ line_1 = ""
$ line_2 = ""
$ line_3 = ""
$ line_4 = ""
$ line_5 = ""
$ line_6 = ""
$ eof_flag = 0
$ read/end_of_file=no_records prompt_file line_1
$ read/end_of_file=eof prompt_file line_2
$ if string_count .eq. 4 then goto not_eof
$ read/end_of_file=eof prompt_file line_3
$ read/end_of_file=eof prompt_file line_4
$ read/end_of_file=eof prompt_file line_5
$ read/end_of_file=eof prompt_file line_6
$ goto not_eof
$ no_records:
$ eof_flag = 1
$ return
$ eof:
$ eof_flag = 1
$ not_eof:
$ gosub build_sixel
$ character_string = character_string + character
$ if continue then goto not_eof
$ return
$!****************************************************************************
$ build_sixel:
$! Look at the first two characters on each of the six lines,
$! line_1 through line_6. Each pair represents one pixel and
$! the full six pairs represent one sixel. Find the correct
$! character to represent that sixel and store it in the symbol
$! 'character'. Set the value of 'continue' to 1 as long as
$! there are characters left in any of the lines.
$ continue = 0
$ bit_value = 63
$ pixel = f$extract(0,1,line_1)
$ length = f$length(line_1)
$ if length .gt. 1 then continue = 1
$ line_1 = f$extract(1,length-1,line_1)
$ if pixel .eqs. "X" then bit_value = bit_value + 1
$ pixel = f$extract(0,1,line_2)
$ length = f$length(line_2)
$ if length .gt. 1 then continue = 1
$ line_2 = f$extract(1,length-1,line_2)
$ if pixel .eqs. "X" then bit_value = bit_value + 2
$ pixel = f$extract(0,1,line_3)
$ length = f$length(line_3)
$ if length .gt. 1 then continue = 1
$ line_3 = f$extract(1,length-1,line_3)
$ if pixel .eqs. "X" then bit_value = bit_value + 4
$ pixel = f$extract(0,1,line_4)
$ length = f$length(line_4)
$ if length .gt. 1 then continue = 1
$ line_4 = f$extract(1,length-1,line_4)
$ if pixel .eqs. "X" then bit_value = bit_value + 8
$ pixel = f$extract(0,1,line_5)
$ length = f$length(line_5)
$ if length .gt. 1 then continue = 1
$ line_5 = f$extract(1,length-1,line_5)
$ if pixel .eqs. "X" then bit_value = bit_value + 16
$ pixel = f$extract(0,1,line_6)
$ length = f$length(line_6)
$ if length .gt. 1 then continue = 1
$ line_6 = f$extract(1,length-1,line_6)
$ if pixel .eqs. "X" then bit_value = bit_value + 32
$ character[0,7]=bit_value
$ return
$!*************************************************************************
|
| This one has got lots of ideas for prompts on a VT200.
$ wrt:==write sys$output
$ N = ''F$EXTRACT(5,1,F$GETSYI("NODENAME"))
$ LF[0,7]=10
$ CR[0,7]=13
$ ESC[0,8]=27
$ CO[0,7]=15
$ CN[0,7]=14
$ IF P1.NES."" THEN WHICH = P1
$ IF P1.NES."" THEN GOTO 'P1'
$ wrt "PROMPT OPTIONS:"
$ wrt ""
$ wrt "1. Brontosaurus 2. Racing car 3. Train 4. Finger"
$ wrt "5. Garfield 6. Woodstock 7. Bridge 8. Alligator"
$ wrt "9. Rabbit 10. Ferrari 11. Snoopy 12. Telephone"
$ wrt "13. Koala 14. Beer Glass 15. Head 16. Gun"
$ wrt "17. Owl 18. Wine Glass 19. Windmill 20. Tortoise"
$ wrt "21. Mickey Mouse 22. Harvey Smith 23. Nudger"
$ wrt ""
$ inp:
$ inquire which 'Prompt'
$ if which .lt. 1 then goto inp
$ if which .gt. 23 then goto inp
$ goto 'which'
$ 1:
$ !Brontosaurus
$ wrt "''ESC'P;3;1{1?????_oo/@AAABBA?;ww{}}}{{/KNLBBBFN;wwo_????/"
$ wrt "G?@BABBA''ESC'\"
$ set prompt = "''ESC')1''CN'''ESC'[1m#$%''ESC')1''CO'''ESC'[0m"
$ wrt ""
$ exit
$ 2:
$ !Racing car
$ wrt "''ESC'M''ESC'P1;17;1{ @KKwwGGg_/??FCEDGG;GGggw__o/DA?DDDFD;_______/"
$ wrt "DDDDDDDD;/DDEC?EHH''ESC'\"
$ wrt "''ESC'M''ESC'P1;21;1{ @/E??ECCC;wcQQQQc/@AAAAA@;AAAaQIE/???B;kQQQQQk/"
$ wrt "@AAAAA@''ESC'\''ESC'M''ESC') @"
$ set prompt = "''ESC'[1m''ESC') @''N'''CN'12345''CO'''ESC'[0m"
$ wrt ""
$ exit
$ 3:
$ !Train
$ wrt "''ESC'P;3;1{1??__OOOO/??@@DDNN;OO^^^^OO/DD@@@@@@;OOOO]]YY/"
$ wrt "@@@@@@@@;YYAA}}__/DDNNDD;____wwWW/????@@DD;WWWWWWWW/"
$ wrt "NNDD@@@@;WWWWWWww/DDNNDD@@;________;WWWW[[WW/@@DDNNDD;[[WW[[WW/"
$ wrt "@@@@DDNN;[[ww____/DD@@;__wwww{{/??@@DDNN;yy{{yy{{/"
$ wrt "DD@@@@DD;yy{{wwoo/NNDD@@''ESC'\"
$ set prompt = -
"''ESC')1''N'''CN'''ESC'[1m#$%&'()*+,-./0''ESC')1''CO'''ESC'[0m"
$ wrt ""
$ exit
$ 4:
$ !Finger
$ wrt "''ESC'P1;3;1{1????????/?????M@@''ESC'/",-
"''ESC'P1;4;1{1?}@@@}??/@N?KA@@@''ESC'/",-
"''ESC'P1;5;1{1????????/MCAACG??''ESC'/",-
"''ESC'P1;6;1{1????????/????????''ESC'/",-
"''ESC'P1;7;1{1???{A@@@/????BCG?''ESC'/",-
"''ESC'P1;8;1{1@XhHHMAF/???F????''ESC'/",-
"''ESC'P1;9;1{1GGCB{F??/??KB????''ESC'/"
$ wrt ""
$ set prompt="''ESC'[1m''ESC')1''CN'#$%&''CR'''LF''()&''CO'''ESC'[0m�"
$ exit
$ 5:
$ !Garfield
$ wrt "''ESC'P1;3;1{1??__OOGG/??FFCCCC;eevvuu??/",-
"CCCCAAEE;uuvveeGG/AACCCCCC;OO__????/",-
"CCJJ????''ESC'/''ESC'P1;7;1{1^^__????/",-
"????@@??;MM}}????/BBBBBB??;??}}MM??/",-
"BBBBBB??;??__^^??/@@??????''ESC'/"
$ wrt ""
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%&''CR'''LF''()*''ESC')1''CO'''ESC'[0m�"
$ exit
$ 6:
$ !Woodstock
$ wrt "''esc'P1;3;1{1OO__GGOO/GGCCDDEE;aa{{__OO/LL????@@;gggggg??/",-
"AACCCCDD;????????/CCGG????''esc'/"
$ wrt "''esc'P1;7;1{1CCAAHHDD/????KKBB;qqKKOO``/????????;OOOOOOOO/",-
"@@MM????;OOGGFF??/????????''esc'/"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%&''CR'''LF''()*''ESC')1''CO'''ESC'[0m�"
$ wrt ""
$ exit
$ 7:
$ !Bridge
$ wrt "''ESC'P1;1;1{1@Ow{}{wO/??@B@;[}{o{}[/??@B@;oW[}[Wo/@?CFC?@;wOU}UOw/"
$ wrt "??CFC''ESC'\"
$ wrt "''ESC'P1;5;1{1@Ow{}{wO/??@B@;[}{o{}[/??@B@;Ow{}{wO/??@B@;??wCA/"
$ wrt "???@A''ESC'\"
$ set prompt = "''ESC'[1m''ESC')1''CN'$'&#''ESC')1''CO' �''ESC'[m"
$ exit
$ 8:
$ ! Alligator
$ wrt "''ESC'P1;65;1{#1w{}q'_o_/???@@@@@;o___o__o/@@@@@@@@;WWoo_GWo/"
$ wrt "B??FNGGB;wwooowwo/BBBBBBBB;WWoo_GWw/B??FNGGB;{kKSSSSW/"
$ wrt "@@@BAABA;WGGWGGWK/BAABAABA;WG??????/BA??????;''ESC'\"
$ set prompt="''ESC'[1m''ESC'(#1abcddefgh''ESC'(B''ESC'[0m"
$ exit
$ 9:
$ ! Rabbit
$ wrt "''ESC'P1;3;1{1????{{AA/????BBCC;AAAA{{????/GGGGFF??;{{AAAAAA/"
$ wrt "FFGGGGCC;{{??????/BB??????''ESC'\"
$ wrt "''ESC'P1;7;1{1??__OOSS/??@@AAAA;II@@CC__/AAFFFF??;CC@@@@II/"
$ wrt "FFFF@@AA;SSOO__??/@@@@AA??''ESC'\"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%&''CR'''LF''()*''ESC')1''CO'''ESC'[0m�"
$ exit
$ 10:
$ ! Ferrari
$ wrt "''ESC'P;3;1{1/????EEFF;?___oooW/DCCCFFF?;GgcSSSSc/BCCGJJGC;kK[{wwwo/"
$ wrt "CB?FFFFF;wwsssqqq/FFFFFFFF;pppppppp/FFFFFFFF;ppxx||~~/"
$ wrt "FFFFFFFF;}}}}]Mmc/FFFF?BCC;SSSSckGW/GJJGCCB?;wwwwwoo_/"
$ wrt "FFFFFFCC;_/B;/;/''ESC'\"
$ set prompt = "''ESC')1''CN'#$%&'()*+,-''ESC')1''CO'''ESC'[0m�"
$ exit
$ 11:
$ ! Snoopy
$ wrt "''ESC'P1;3;1{1??__OOGG/??@@IIKK;CCCCGGOO/NN????II;________/"
$ wrt "????????;????????/HHEEAA??''ESC'\"
$ wrt "''ESC'P1;7;1{1bbVVVVJJ/@@AACCCC;EEwwEEGG/DDCCCCEE;pp@@@@@@/"
$ wrt "FFEEDDDD;????????/DDEE????''ESC'\"
$ set prompt = "''ESC')1''CN'#$%&''CR'''LF''()*''ESC')1''CO'''ESC'[0m"
$ exit
$ 12:
$ !Telephone
$ wrt "''ESC'P1;3;1{1???__oww/??EFFFF@;wwwwwwww/KKGGGGGK;wwwo__??/"
$ wrt "@@FFFFE?;??w{}~hB/??FFFFFF;B@W{{W@B/FECCCCEF;Bh~}{w??/"
$ wrt "FFFFFF??''ESC'\"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%''ESC')1''CO'''CR'''LF'''ESC')1''CN'&'(''ESC')1''CO'�"
$ exit
$ 13:
$ ! Koala
$ set prompt = "''ESC')0''CN'f''ESC'[4m`''ESC[mf''CO'"
$ exit
$ 14:
$ ! Beer glass
$ wrt "''ESC'P1;1;1{1???_;??G/?????@;~@h@PH`P/N???A?G;H`H@`H@~/"
$ wrt "?C??G??N;GGGGGOo/??????GF;~??C??O/NGGGHGGG;?C??O??~/"
$ wrt "GGIGGGGN;AAAAAB@''ESC'\"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%''ESC'1''CO'''CR'''LF'''ESC')1''CN'&'(''ESC')1''CO'"
$ exit
$ 15:
$ !Head
$ wrt "''ESC'P1;3;1{1????????/????MM@@;????WWww/@@@@@@II;WWWWWWWW/"
$ wrt "??EE@@AA;WWoo__??/MM??NN??''ESC'\"
$ wrt "''ESC'P1;7;1{1??????@@/??KKMMNN;``^^GGKK/NNNN??EE;GG????``/"
$ wrt "AAEE@@NN;pp}}oo__/NNNNNNNN''ESC'\"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%&''CR'''LF''()*''ESC')1''CO'''ESC'[0m�"
$ exit
$ 16:
$ !Gun
$ wrt "''ESC'P1;3;1{1?wwwwwww/BFNNNNNN;wwwwwwww/BBNBBBNB;wwwwww{w/"
$ wrt "BBBBBBB?;??^~~~~^/;AAAAAA@?/;/''ESC'\"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%''ESC')1''CO'''CR'''LF'''ESC')1''CN'&'(''ESC')1''CO'�"
$ exit
$ 17:
$ !Owl
$ wrt "''ESC'P1;3;1{1?????[}b/?GCAAAIN;bbb]]bbb/NNNMMNNN;b}[?????/"
$ wrt "NIAAACG?;?~???N^~/??@@AE@A;~~~~~~~~/ANN@@NNA;~^N???~?/"
$ wrt "A@EA@@??''ESC'\"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%''ESC')1''CO'''CR'''LF'''ESC')1''CN'&'(''ESC')1''CO'�"
$ exit
$ 18:
$! Wine Glass
$ wrt "''ESC'P1;1;1{1????O;???O/???A;~@@@@@@@/@BAAECCC;@@@@@@@@/"
$ wrt "KGGGGGGK;@@@@@@@~/CCCEAAB@;/GGGKKMMN;??_~~_/MNNNNNNN;/"
$ wrt "NMMKKGGG''ESC'\
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%''ESC')1''CO'''CR'''LF'''ESC')1''CN'&'(''ESC')1''CO'"
$ exit
$ 19:
$! Windmill
$ wrt "''ESC'P;3;1{1AACCggww/AAHHNNNN;ggCCAA??/NNHHAA??''ESC'\"
$ set prompt = "''ESC')1''CN'''ESC'[1;5m#$''ESC')1''CO'''ESC'[0m >>"
$ exit
$ 20:
$ !Tortoise
$ wrt "''ESC'P;3;1{1oo__wwww/??@@????;__??__oo/@@FFNNFF;oooooo__/"
$ wrt "FFNNFFFF;ww{{ww??/@@BBBB@@''ESC'\"
$ set prompt = "''ESC')1''CN'''ESC'[1;5m#$%''ESC')1''CO'''ESC'[0m >>"
$ exit
$ 21:
$ !Mickey Mouse
$ wrt "''ESC'P;3;1{1????EENN/????????;nn}}cc}}/@@AACCKK;cc}}nnNN/"
$ wrt "CCAA@@??;EE??????/????????''ESC'\"
$ set prompt = "''CR'''LF'''ESC')1''CN'''ESC'[1m#$%&''ESC')1''CO'�''ESC'[0m"
$ exit
$ 22:
$ !Harvey Smith
$ wrt "''ESC'P1;3;1{1???}@@@}/???N???F;}@@@}??/F?KA@@@;/MCAACG??;???|A@@@/"
$ wrt "????BCG?;@XhHHMAF/???F????;GGCB{F??/??KB????''ESC'\"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%''ESC')1''CO'''CR'''LF'''ESC')1''CN'&'(''ESC')1''CO'�"
$ exit
$ 23:
$ ! Nudger
$ wrt "''ESC'P1;3;1{1/;{IHJJHI{/N??????N;/;?_WGCCCC/??BACCCC;FG[__[GF/"
$ wrt "CAB??BAC;CCCCGW_?/CCCCAB??''ESC'\"
$ set prompt = -
"''ESC'[1m''ESC')1''CN'#$%''ESC')1''CO'''CR'''LF'''ESC')1''CN'&'(''ESC')1''CO'�"
|