about summary refs log blame commit diff stats
path: root/charterm/test-charterm.rkt
blob: 04eb376ffa87b16c53b127fbfbffaf1f620b396f (plain) (tree) 
bfeb6d7b ^




















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20




















                                           
#lang racket/base
;; For legal info, see file "charterm.rkt".

;; (require (planet neil/charterm:1))
(require "charterm.rkt")

(with-charterm
 (charterm-clear-screen)
 (charterm-cursor 10 5)
 (charterm-display "Hello, ")
 (charterm-bold)
 (charterm-display "you")
 (charterm-normal)
 (charterm-display ".")
 (charterm-cursor 1 1)
 (charterm-display "Press a key...")
 (let ((key (charterm-read-key)))
   (charterm-cursor 1 1)
   (charterm-clear-line)
   (printf "You pressed: ~S\r\n" key)))
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2024-11-12 17:20:14 +0000
'oid'>f32e575e ^ 
7ecfd5eb ^





e43ff485 ^




















a0deaa1c ^


593b9524 ^


























a0deaa1c ^



593b9524 ^

a553a5e2 ^





7ecfd5eb ^


593b9524 ^

a0deaa1c ^

7ecfd5eb ^




a553a5e2 ^


a0deaa1c ^

7ecfd5eb ^






11d3ce71 ^

















a71e5326 ^

7ecfd5eb ^

5234c224 ^

7ecfd5eb ^



abfdb26c ^


abfdb26c ^

a0deaa1c ^

22a7849a ^

a0deaa1c ^


22a7849a ^





e0bceffe ^

22a7849a ^






a0deaa1c ^


6d35f049 ^

985f2268 ^

bf1b3155 ^

6d35f049 ^

985f2268 ^


e0bceffe ^

985f2268 ^




22a7849a ^

985f2268 ^

22a7849a ^

a0deaa1c ^



985f2268 ^

bf1b3155 ^

a0deaa1c ^




a0deaa1c ^


8e4b4f20 ^

7e7d298b ^



a0deaa1c ^





e0bceffe ^

4449f487 ^

8e4b4f20 ^

f8104b38 ^

e655f673 ^

8152b0d1 ^

4c363e6e ^




bf1b3155 ^

4c363e6e ^

7e7d298b ^


d061cbff ^


4c363e6e ^

8e4b4f20 ^

4c363e6e ^

4449f487 ^

f8104b38 ^

4c363e6e ^


d061cbff ^

4c363e6e ^








8e4b4f20 ^

8e4b4f20 ^

8e4b4f20 ^

72e8240a ^

e655f673 ^

7e7d298b ^

72e8240a ^

ce1b9976 ^






1436f029 ^







e655f673 ^

1436f029 ^



72e8240a ^

8e4b4f20 ^

4449f487 ^

e655f673 ^

8e4b4f20 ^

a0deaa1c ^

e655f673 ^


d061cbff ^

a4f5e386 ^

04d06dfe ^

















e655f673 ^

d061cbff ^

e655f673 ^






5234c224 ^














37028589 ^









5234c224 ^

11d3ce71 ^




1
2

3

4

5
6
7

8
9
10
11

12
13
14
15
16
17

18
19
20
21
22
23
24
25
26
27

28
29

30

31
32
33
34
35
36
37
38
39
40

41

42
43

44
45
46
47
48
49
50
51
52
53
54

55
56
57

58
59
60

61
62
63

64

65
66
67
68
69
70
71

72

73
74
75
76
77
78
79
80

81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105

106
107

108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

134
135
136

137

138
139
140
141
142

143
144

145

146

147
148
149
150

151
152

153

154
155
156
157
158
159

160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176

177

178

179

180
181
182

183
184

185

186

187

188
189

190
191
192
193
194

195

196
197
198
199
200
201

202
203

204

205

206

207

208
209

210

211
212
213
214

215

216

217

218
219
220

221

222

223
224
225
226

227
228

229

230
231
232

233
234
235
236
237

238

239

240

241

242

243

244
245
246
247

248

249

250
251

252
253

254

255

256

257

258

259
260

261

262
263
264
265
266
267
268
269

270

271

272

273

274

275

276

277
278
279
280
281
282

283
284
285
286
287
288
289

290

291
292
293

294

295

296

297

298

299

300
301

302

303

304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320

321

322

323
324
325
326
327
328

329
330
331
332
333
334
335
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350
351

352

353
354
355
356


                         
                           
                            


                         



                                                    





                                                                    









                                                            

                                     
                                     









                                                            
                  

                                         










                                                                                              


                                                     


                                       


                                                                         
                                                      






                                                                
                                           







                                                                       




                                        



















                                                                         

                         

























                                                                                       


                              
                       




                                                                         

                         
                                              
                                   



                                                 

                                                                         
                                         





                                   
















                                                                           
                                    
                                              
                  


                                                            

                                                              
                                       
               
                                                                    

                                                             




                                                               
                                                           





                                                                     

                     
                                                        
   
                                                                                          
                                                

 
                                                                                                                                                                                                 



                                                             
                           
                                        
   


                        
                                         
                                                                                                                   



                                                                   

 
         


                                                                                                                    




                                                                               
                                                                                                                                                                                                                                                    
                                  
   
                  
                                              
                                                                



                                                         
                                                            
                  

                                         

                                                             
                                                 
     
                  
                 
                                                

                                                    
                                             







                                             
     
   
 
                                  
                         
                                       
                               





                                               






                                                         
                                


                                                 
 
                          
                             
                           
                                    
 

              
                                                                   
                                   
















                            
                                      
                                                            





                                                                              













                                                                 








                                      
 



                                                      
type environment {
  screen: (handle screen)
  program: (handle program)
  cursor-word: (handle word)
  nrows: int
  ncols: int
  code-separator-col: int
}

fn initialize-environment _env: (addr environment) {
  var env/esi: (addr environment) <- copy _env
  var program-ah/eax: (addr handle program) <- get env, program
  allocate program-ah
  var program/eax: (addr program) <- lookup *program-ah
  var cursor-word-ah/ecx: (addr handle word) <- get env, cursor-word
  initialize-program program, cursor-word-ah
  # initialize screen
  var screen-ah/eax: (addr handle screen) <- get env, screen
  var _screen/eax: (addr screen) <- lookup *screen-ah
  var screen/edi: (addr screen) <- copy _screen
  var nrows/eax: int <- copy 0
  var ncols/ecx: int <- copy 0
  nrows, ncols <- screen-size screen
  var dest/edx: (addr int) <- get env, nrows
  copy-to *dest, nrows
  dest <- get env, ncols
  copy-to *dest, ncols
  var repl-col/ecx: int <- copy ncols
  repl-col <- shift-right 1
  dest <- get env, code-separator-col
  copy-to *dest, repl-col
}

fn draw-screen _env: (addr environment) {
  var env/esi: (addr environment) <- copy _env
  var screen-ah/eax: (addr handle screen) <- get env, screen
  var _screen/eax: (addr screen) <- lookup *screen-ah
  var screen/edi: (addr screen) <- copy _screen
  var dest/edx: (addr int) <- get env, code-separator-col
  var tmp/eax: int <- copy *dest
  clear-canvas env
  tmp <- add 2  # repl-margin-left
  move-cursor screen, 3, tmp  # input-row
}

fn initialize-environment-with-fake-screen _self: (addr environment), nrows: int, ncols: int {
  var self/esi: (addr environment) <- copy _self
  var screen-ah/eax: (addr handle screen) <- get self, screen
  allocate screen-ah
  var screen-addr/eax: (addr screen) <- lookup *screen-ah
  initialize-screen screen-addr, nrows, ncols
  initialize-environment self
}

fn process _self: (addr environment), key: grapheme {
$process:body: {
    var self/esi: (addr environment) <- copy _self
    compare key, 0x445b1b  # left-arrow
    {
      break-if-!=
      var cursor-word-ah/edi: (addr handle word) <- get self, cursor-word
      var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
      var cursor-word/ecx: (addr word) <- copy _cursor-word
      # if not at start, move left within current word
      var at-start?/eax: boolean <- cursor-at-start? cursor-word
      compare at-start?, 0  # false
      {
        break-if-=
        cursor-left cursor-word
        break $process:body
      }
      # otherwise, move to end of prev word
      var prev-word-ah/esi: (addr handle word) <- get cursor-word, prev
      var prev-word/eax: (addr word) <- lookup *prev-word-ah
      {
        compare prev-word, 0
        break-if-=
        copy-object prev-word-ah, cursor-word-ah
        cursor-to-end prev-word
      }
      break $process:body
    }
    compare key, 0x435b1b  # right-arrow
    {
      break-if-!=
      var cursor-word-ah/edi: (addr handle word) <- get self, cursor-word
      var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
      var cursor-word/ecx: (addr word) <- copy _cursor-word
      # if not at end, move right within current word
      var at-end?/eax: boolean <- cursor-at-end? cursor-word
      compare at-end?, 0  # false
      {
        break-if-=
        cursor-right cursor-word
        break $process:body
      }
      # otherwise, move to start of next word
      var next-word-ah/esi: (addr handle word) <- get cursor-word, next
      var next-word/eax: (addr word) <- lookup *next-word-ah
      {
        compare next-word, 0
        break-if-=
        copy-object next-word-ah, cursor-word-ah
        cursor-to-start next-word
      }
      break $process:body
    }
    compare key, 0x7f  # del (backspace on Macs)
    {
      break-if-!=
      var cursor-word-ah/edi: (addr handle word) <- get self, cursor-word
      var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
      var cursor-word/ecx: (addr word) <- copy _cursor-word
      # if not at start of some word, delete grapheme before cursor within current word
      var at-start?/eax: boolean <- cursor-at-start? cursor-word
      compare at-start?, 0  # false
      {
        break-if-=
        delete-before-cursor cursor-word
        break $process:body
      }
      # otherwise delete current word and move to end of prev word
      var prev-word-ah/esi: (addr handle word) <- get cursor-word, prev
      var prev-word/eax: (addr word) <- lookup *prev-word-ah
      {
        compare prev-word, 0
        break-if-=
        copy-object prev-word-ah, cursor-word-ah
        cursor-to-end prev-word
        delete-next prev-word
      }
      break $process:body
    }
    compare key, 0x20  # space
    {
      break-if-!=
      # insert new word
      var cursor-word-ah/edx: (addr handle word) <- get self, cursor-word
      append-word cursor-word-ah
      var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
      var next-word-ah/ecx: (addr handle word) <- get cursor-word, next
      copy-object next-word-ah, cursor-word-ah
      break $process:body
    }
    # otherwise insert key within current word
    var g/edx: grapheme <- copy key
    var print?/eax: boolean <- real-grapheme? key
    {
      compare print?, 0  # false
      break-if-=
      var cursor-word-ah/eax: (addr handle word) <- get self, cursor-word
      var cursor-word/eax: (addr word) <- lookup *cursor-word-ah
      add-grapheme-to-word cursor-word, g
      break $process:body
    }
    # silently ignore other hotkeys
}
}

fn evaluate-environment _env: (addr environment), stack: (addr int-stack) {
  var env/esi: (addr environment) <- copy _env
  # program
  var program-ah/eax: (addr handle program) <- get env, program
  var _program/eax: (addr program) <- lookup *program-ah
  var program/esi: (addr program) <- copy _program
  # defs
  var defs/edx: (addr handle function) <- get program, defs
  # line
  var sandbox-ah/esi: (addr handle sandbox) <- get program, sandboxes
  var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
  var line-ah/eax: (addr handle line) <- get sandbox, data
  var _line/eax: (addr line) <- lookup *line-ah
  var line/esi: (addr line) <- copy _line
  evaluate defs, 0, line, 0, stack
}

fn render _env: (addr environment) {
  var env/esi: (addr environment) <- copy _env
  clear-canvas env
  var screen-ah/edi: (addr handle screen) <- get env, screen
  var _screen/eax: (addr screen) <- lookup *screen-ah
  var screen/edi: (addr screen) <- copy _screen
  var _repl-col/ecx: (addr int) <- get env, code-separator-col
  var repl-col/ecx: int <- copy *_repl-col
  repl-col <- add 2  # repl-margin-left
  # cursor-word
  var cursor-word-ah/ebx: (addr handle word) <- get env, cursor-word
  var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah
  var cursor-word/ebx: (addr word) <- copy _cursor-word
  # program
  var program-ah/eax: (addr handle program) <- get env, program
  var _program/eax: (addr program) <- lookup *program-ah
  var program/esi: (addr program) <- copy _program
  # defs
  var defs/edx: (addr handle function) <- get program, defs
  # line
  var sandbox-ah/esi: (addr handle sandbox) <- get program, sandboxes
  var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah
  var line-ah/eax: (addr handle line) <- get sandbox, data
  var _line/eax: (addr line) <- lookup *line-ah
  var line/esi: (addr line) <- copy _line
  # cursor-col
  var cursor-col: int
  var cursor-col-a/eax: (addr int) <- address cursor-col
  #
  render-line screen, defs, 0, line, 3, repl-col, cursor-word, cursor-col-a  # input-row=3
  move-cursor screen, 3, cursor-col  # input-row
}

fn render-line screen: (addr screen), defs: (addr handle function), bindings: (addr table), _line: (addr line), top-row: int, left-col: int, cursor-word: (addr word), cursor-col-a: (addr int) {
  # curr-word
  var line/esi: (addr line) <- copy _line
  var first-word-ah/eax: (addr handle word) <- get line, data
  var curr-word/eax: (addr word) <- lookup *first-word-ah
  # loop-carried dependency
  var curr-col/ecx: int <- copy left-col
  #
  {
    compare curr-word, 0
    break-if-=
    move-cursor screen, top-row, curr-col
    curr-col <- render-column screen, defs, bindings, line, curr-word, top-row, curr-col, cursor-word, cursor-col-a
    var next-word-ah/edx: (addr handle word) <- get curr-word, next
    curr-word <- lookup *next-word-ah
    loop
  }
}

# Render:
#   - starting at top-row, left-col: final-word
#   - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive)
#     unless final-word is truly the final word, in which case it might be incomplete
#
# Outputs:
# - Return the farthest column written.
# - If final-word is same as cursor-word, do some additional computation to set
#   cursor-col-a.
fn render-column screen: (addr screen), defs: (addr handle function), bindings: (addr table), scratch: (addr line), final-word: (addr word), top-row: int, left-col: int, cursor-word: (addr word), cursor-col-a: (addr int) -> right-col/ecx: int {
  var max-width/ecx: int <- copy 0
  {
    # indent stack
    var indented-col/ebx: int <- copy left-col
    indented-col <- add 1  # margin-right - 2 for padding spaces
    # compute stack
    var stack: int-stack
    var stack-addr/edi: (addr int-stack) <- address stack
    initialize-int-stack stack-addr, 0x10  # max-words
    evaluate defs, bindings, scratch, final-word, stack-addr
    # render stack
    var curr-row/edx: int <- copy top-row
    curr-row <- add 3  # stack-margin-top
    var _max-width/eax: int <- int-stack-max-width stack-addr
    var max-width/esi: int <- copy _max-width
    var i/eax: int <- int-stack-length stack-addr
    {
      compare i, 0
      break-if-<=
      move-cursor screen, curr-row, indented-col
      {
        var val/eax: int <- pop-int-stack stack-addr
        render-integer screen, val, max-width
        var size/eax: int <- decimal-size val
        compare size, max-width
        break-if-<=
        max-width <- copy size
      }
      curr-row <- increment
      i <- decrement
      loop
    }
  }

  # render word, initialize result
  reset-formatting screen
  move-cursor screen, top-row, left-col
  print-word screen, final-word
  {
    var size/eax: int <- word-length final-word
    compare size, max-width
    break-if-<=
    max-width <- copy size
  }

  # update cursor
  {
    var f/eax: (addr word) <- copy final-word
    compare f, cursor-word
    break-if-!=
    var cursor-index/eax: int <- cursor-index cursor-word
    cursor-index <- add left-col
    var dest/edi: (addr int) <- copy cursor-col-a
    copy-to *dest, cursor-index
  }

  # post-process right-col
  right-col <- copy max-width
  right-col <- add left-col
  right-col <- add 3  # margin-right
}

# synaesthesia
fn render-integer screen: (addr screen), val: int, max-width: int {
  var bg/eax: int <- hash-color val
  var fg/ecx: int <- copy 7
  {
    compare bg, 2
    break-if-!=
    fg <- copy 0
  }
  {
    compare bg, 3
    break-if-!=
    fg <- copy 0
  }
  {
    compare bg, 6
    break-if-!=
    fg <- copy 0
  }
  start-color screen, fg, bg
  print-grapheme screen, 0x20  # space
  print-int32-decimal-right-justified screen, val, max-width
  print-grapheme screen, 0x20  # space
}

fn hash-color val: int -> result/eax: int {
  result <- try-modulo val, 7  # assumes that 7 is always the background color
}

fn clear-canvas _env: (addr environment) {
  var env/esi: (addr environment) <- copy _env
  var screen-ah/edi: (addr handle screen) <- get env, screen
  var _screen/eax: (addr screen) <- lookup *screen-ah
  var screen/edi: (addr screen) <- copy _screen
  clear-screen screen
  var nrows/eax: (addr int) <- get env, nrows
  var _repl-col/ecx: (addr int) <- get env, code-separator-col
  var repl-col/ecx: int <- copy *_repl-col
  draw-vertical-line screen, 1, *nrows, repl-col
  repl-col <- add 2  # repl-margin-left
  move-cursor screen, 5, repl-col  # input-row + stack-margin-top
  print-string screen, "stack:"
  move-cursor screen, *nrows, repl-col
  start-reverse-video screen
  print-string screen, " ctrl-r "
  reset-formatting screen
  print-string screen, " rename  "
  start-reverse-video screen
  print-string screen, " ctrl-s "
  reset-formatting screen
  print-string screen, " tbd  "
}

fn real-grapheme? g: grapheme -> result/eax: boolean {
  result <- copy 1  # true
}
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2024-11-12 17:20:12 +0000